Excel – How to automatically import data from csv file and append to existing Excel table

csvmicrosoft excelmicrosoft-excel-2016vbavisual basic

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

destCell.Parent.QueryTables(1).Delete

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?

Best Answer

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
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
Related Question