将多个文本文件合并到一个Excel工作表中

Posted 2021-04-10

我有27个具有相同格式和列的txt文件，我想在一个excel表中附加所有这些文件。我在这里检查了一些以前的线程，但我只能找到下面的代码，它帮助我将txt fiels导入到单独的工作表中。但是，我还想将这些单独的工作表附加到我想要附加所有数据的工作表中。

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Vendor_data_25DEC]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath)
    'xFile = Dir(xStrPath & "*.txt") 'this is the original version that you can amend according to file extension
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Vendor_data_25DEC"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

---

我不确定如何使用VBA执行此操作，以便将单独工作表中的数据快速合并到一个工作表中。我知道excel的整合功能，但它还包括许多手动步骤，因此我寻求更快速和自动化的解决方案。任何帮助深表感谢。非常感谢提前。

答案

Sub Combiner()

    Dim strTextFilePath$, strFolder$
    Dim wksTarget As Worksheet
    Dim wksSource As Worksheet
    Dim x As Long

    Set wksTarget = Sheets.Add()
    strFolder = "c:\Temp\test\"
    strTextFilePath = Dir(strFolder)

    While Len(strTextFilePath) > 0
        '// "x" variable is just a counter.
        '// It's purpose is to track whether the iteration is first or not.
        '// If iteration is first (x=1), then we include header (zero offset down),
        '// otherwise - we make an offset (1 row offset down).
        x = x + 1
        Set wksSource = Workbooks.Open(strFolder & strTextFilePath).Sheets(1)
        With wksTarget
            wksSource.Range("A1").CurrentRegion.Offset(IIf(x = 1, 0, 1)).Copy _
                      .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
        End With
        wksSource.Parent.Close False
        strTextFilePath = Dir()
    Wend

    MsgBox "Well done!", vbInformation

End Sub