I have a .csv file and a master excel file. The master file contains a table and I would like to automatically append the data in the .csv file to the existing table. The data has the same headers and column order. I have the folllowing VBA which appends the .csv data to the next row after the table fine, but the data is not part of the table:

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, 
    .TextFileStartRow = 2
    .TextFileParseType = xlDelimited
    .TextFileCommaDelimiter = True
    .Refresh BackgroundQuery:=False
End With


End Sub

There are also columns in the table to the right of the data that calculate a value from the imported data. Is there anyway to automatically have the formulas copied down the column when the new data is appended?


I had the same issue, and wanted to append several (16 to be precise) csv files in one listing. The Array I used is static and there are better ways of coding this, but I needed to collect specific files from a number of csv files that are within the folder location.

I found your code interesting, and updated the code that I had put together from other sources to get a set of code working.

Thanks for sharing your code, as you will see I've used an element of your code to find the next blank row to append to.

See below code example, you will need to add the filenames, and file directory path, and update the xFiles array to match the number of files that you want to import and append:

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
Selection.Delete Shift:=xlToLeft

'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

'Remove the Blank Top row
Selection.Delete Shift:=xlUp

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

Your Answer

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.