Como importar automaticamente dados do arquivo csv e acrescentar à tabela existente do Excel

Question

Eu tenho um arquivo .csv e um arquivo mestre do Excel. O arquivo mestre contém uma tabela e eu gostaria de anexar automaticamente os dados no arquivo .csv à tabela existente. Os dados têm os mesmos cabeçalhos e ordem de coluna. Eu tenho o seguinte VBA que acrescenta os dados .csv para a próxima linha após a tabela bem, mas os dados não fazem parte da tabela:

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

Também há colunas na tabela à direita dos dados que calculam um valor dos dados importados. Existe alguma maneira de ter automaticamente as fórmulas copiadas na coluna quando os novos dados são anexados?

    

Answer 1

Eu tive o mesmo problema e queria acrescentar vários (16 para ser precisos) arquivos csv em uma listagem. A Matriz que usei é estática e há maneiras melhores de codificar isso, mas eu precisava coletar arquivos específicos de vários arquivos csv que estão dentro do local da pasta.

Achei seu código interessante e atualizei o código que eu havia criado de outras fontes para obter um conjunto de códigos funcionando.

Obrigado por compartilhar seu código, como você verá. Usei um elemento do seu código para encontrar a próxima linha em branco a ser anexada.

Veja abaixo o exemplo de código, você precisará adicionar os nomes dos arquivos e o caminho do diretório de arquivos e atualizar o array xFiles para corresponder ao número de arquivos que você deseja importar e anexar:

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