CODEWITHSUNDEEP
vbaexcelappend
Cagdas Kanar
Cagdas Kanar

Reputation: 763

combine multiple text files in a single excel sheet

I have 27 txt files with the same format and columns, and I want to append all of these in a single excel sheet. I have checked some previous threads here, but I could only find the code below which helped me to import txt fiels into separate sheets. However, I also want to append these separate sheets into a sheet that I want to append all my data.

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

I am not sure how to do this with VBA in order to combine the data in separate sheets into a single sheet quickly. I know the consolidate feature of excel but it also includes lots of manual steps, so I seek for a faster and automated solution. Any help is much appreciated. Thanks a lot in advance.

Upvotes: 1

Views: 5902

Answers (1)

JohnyL
JohnyL

Reputation: 7122

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

Upvotes: 2

Related Questions