Import multiple text files into single worksheet

Question

I found the following code which imports each text file into a separate worksheet and it worked perfectly. Is there a way to modify the code so ALL text files are imported into a SINGLE worksheet?

I'm using Excel 2013 on Windows7 64 bit if that makes a difference.

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")    

    For Each txtfile In txtfilesToOpen
        ' FINDS EXISTING WORKSHEET
        For Each xlsheet In ThisWorkbook.Worksheets
            If xlsheet.Name = Replace(fso.GetFileName(txtfile), ".txt", "") Then
                xlsheet.Activate
                GoTo ImportData
            End If
        Next xlsheet

        ' CREATES NEW WORKSHEET IF NOT FOUND
        Set xlsheet = ThisWorkbook.Worksheets.Add( _
                             After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        xlsheet.Name = Replace(fso.GetFileName(txtfile), ".txt", "")
        xlsheet.Activate
        GoTo ImportData

ImportData:
        ' DELETE EXISTING DATA
        ActiveSheet.Range("A:Z").EntireColumn.Delete xlShiftToLeft

        ' IMPORT DATA FROM TEXT FILE
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
          Destination:=ActiveSheet.Cells(1, 1))
            .TextFileParseType = xlDelimited
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "|"

            .Refresh BackgroundQuery:=False
        End With

        For Each qt In ActiveSheet.QueryTables
            qt.Delete
        Next qt
    Next txtfile

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

score 4 · Accepted Answer · answered Jul 09 '18 at 15:29

A lot of the code in here is dealing with creating new tabs etc. so that can go.

What you're left with is a loop that loads each text file into Cells(1,1) - so if we tweak that to point at a value which checks the last used cell in column A, then this should do what you need:

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    With ActiveSheet

        For Each txtfile In txtfilesToOpen

            importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row

            ' IMPORT DATA FROM TEXT FILE
            With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=.Cells(importrow, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .Refresh BackgroundQuery:=False
            End With


        Next txtfile

        For Each qt In .QueryTables
            qt.Delete
        Next qt

    End With

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

Also, I notice you delete 'all' the query tables inside your loop. This isn't necessary. Just delete them all once they're all loaded.

Works perfectly thank you! I don't know anything about coding so this was a great help to me. — MyNameHere, Jul 09 '18 at 16:00

score 2 · Answer 2 · answered Jul 09 '18 at 15:28

I believe the following will do what you expect, this will bring all your text data into a single worksheet, it will check for the last row with data in Column A, and offset by one row to import data from the next Text File:

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim LastRow As Long
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    For Each txtfile In txtfilesToOpen
        LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
        ' IMPORT DATA FROM TEXT FILE
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
          Destination:=ActiveSheet.Cells(LastRow, 1))
            .TextFileParseType = xlDelimited
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "|"

            .Refresh BackgroundQuery:=False
        End With

        For Each qt In ActiveSheet.QueryTables
            qt.Delete
        Next qt
    Next txtfile

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

Import multiple text files into single worksheet

2 Answers2