Verileri otomatik olarak csv dosyasından içe aktarma ve varolan Excel tablosuna ekleme

Bir .csv dosyası ve bir ana excel dosyası var. Ana dosya bir tablo içeriyor ve .csv dosyasındaki verileri otomatik olarak mevcut tabloya eklemek istiyorum. Veriler aynı başlıklara ve sütun sırasına sahiptir. Tablo para cezasından sonra bir sonraki satıra .csv verilerini ekleyen son derece hızlı bir VBA var, ancak veriler tablonun bir parçası değil:

Sub Append_CSV_File()

Dim csvFileName As Variant
Dim destCell As Range

Set destCell = Worksheets("Sheet1").Cells(Rows.Count, 
"E").End(xlUp).Offset(1)      'Sheet1

csvFileName = Application.GetOpenFilename(FileFilter:="CSV Files 
(*.csv),*.csv", Title:="Select a CSV File", MultiSelect:=False)
If csvFileName = False Then Exit Sub

With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & csvFileName, 
Destination:=destCell)
    .TextFileStartRow = 2
    .TextFileParseType = xlDelimited
    .TextFileCommaDelimiter = True
    .Refresh BackgroundQuery:=False
End With

destCell.Parent.QueryTables(1).Delete

End Sub

Tabloda, alınan verilerden bir değer hesaplayan verinin sağındaki sütunlar da vardır. Yeni veriler eklendiğinde formüllerin otomatik olarak sütundan kopyalanmasını sağlamak mümkün mü?

Aynı sorunu yaşadım ve tek bir listeye birkaç (tam olarak 16 tane) csv dosyası eklemek istedim. Kullandığım Dizi statik ve bunu kodlamanın daha iyi yolları var, ancak klasördeki bir dizi csv dosyasından belirli dosyaları toplamam gerekiyordu.

Kodunuzu ilginç buldum ve bir kod kümesi çalışması için diğer kaynaklardan bir araya getirdiğim kodu güncelledim.

Kodunuzu paylaştığınız için teşekkür ederiz, göreceğiniz gibi, eklenecek bir sonraki boş satırı bulmak için kodunuzun bir öğesini kullandım.

Aşağıdaki kod örneğine bakın, dosya adlarını ve dosya dizin yolunu eklemeniz ve içe aktarmak ve eklemek istediğiniz dosya sayısına uyacak şekilde xFiles dizisini güncellemeniz gerekir:

Sub LoadDelimitedFiles()

Dim xStrPath As String
Dim xFile As String
Dim xCount As Long
Dim xFiles(15) As String
Dim destCell As Range

On Error GoTo ErrHandler
'added an update to the code to select the individual file names needed from server within a folder

'PathName of Folder Location
    xStrPath = "<Insert Folder Location>"

'Name the Array with the CSV files name for file Content

    xFiles(0) = "<Filename1>"
    xFiles(1) = "<Filename2>"
    xFiles(2) = "<Filename3>"
    xFiles(3) = "<Filename4>"
    xFiles(4) = "<Filename5>"
    xFiles(5) = "<Filename6>"
    xFiles(6) = "<Filename7>"
    xFiles(7) = "<Filename8>"
    xFiles(8) = "<Filename9>"
    xFiles(9) = "<Filename10>"
    xFiles(10) = "<Filename11>"
    xFiles(11) = "<Filename12>"
    xFiles(12) = "<Filename13>"
    xFiles(13) = "<Filename14>"
    xFiles(14) = "<Filename15>"
    xFiles(15) = "<Filename16>"

    xCount = 0

If xStrPath = "" Then Exit Sub
Application.ScreenUpdating = False

'Clear Existing Sheet Data
Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

'Set the 1st Filename
xFile = Dir(xStrPath & xFiles(xCount) & ".csv")

'destCell contains the location of the next cell to append the next csv file data to
Set destCell = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)

Do While xCount <> 16
    xFile = Dir(xStrPath & xFiles(xCount) & ".csv")
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
      & xStrPath & xFile, Destination:=destCell)
        .Name = "a" & xCount
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

        Set destCell = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1)
        xCount = xCount + 1
        End With

Loop
'Remove the Blank Top row
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select

'Update the screen to show the contents appended csv file data
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
    MsgBox "no files found", , "Error Message"
End Sub