Bdtyktl

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?

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