Cách tự động nhập dữ liệu từ tệp csv và nối vào bảng Excel hiện có

Tôi có tệp .csv và tệp excel chính. Tệp chính chứa một bảng và tôi muốn tự động nối thêm dữ liệu trong tệp .csv vào bảng hiện có. Dữ liệu có cùng tiêu đề và thứ tự cột. Tôi có VBA theo dõi nối thêm dữ liệu .csv vào hàng tiếp theo sau bảng tốt, nhưng dữ liệu không phải là một phần của bảng:

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

Ngoài ra còn có các cột trong bảng bên phải dữ liệu tính toán một giá trị từ dữ liệu đã nhập. Có cách nào để tự động sao chép các công thức xuống cột khi dữ liệu mới được nối không?

Tôi có cùng một vấn đề và muốn thêm một số tệp csv (16 chính xác) vào một danh sách. Mảng tôi sử dụng là tĩnh và có nhiều cách mã hóa tốt hơn, nhưng tôi cần thu thập các tệp cụ thể từ một số tệp csv nằm trong vị trí thư mục.

Tôi thấy mã của bạn thú vị và cập nhật mã mà tôi đã kết hợp từ các nguồn khác để làm cho một bộ mã hoạt động.

Cảm ơn vì đã chia sẻ mã của bạn, vì bạn sẽ thấy tôi đã sử dụng một yếu tố trong mã của mình để tìm hàng trống tiếp theo để thêm vào.

Xem ví dụ mã bên dưới, bạn sẽ cần thêm tên tệp và đường dẫn thư mục tệp và cập nhật mảng xFiles để khớp với số lượng tệp bạn muốn nhập và chắp thêm:

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