Import Text Files onto SAME worksheet

[Legacy 323112]

Hi all,
I'm looking to navigate to a folder, select txt files, and import each onto the same worksheet in an existing workbook, one after another (vertically). I found some code on;
Importing Multiple Files to a Single Workbook (Microsoft Excel)
which almost does exactly what I need, although it creates a new workbook and it imports each .txt file onto a new worksheet.

Does anybody know how to tweak it such that each .txt file can be imported sequentially onto the same worksheet of my existing workbook?

Any advice would be most appreciated!

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

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

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

 

[Legacy 323112]

Hi, I have a feeling this is to do with my data.
Thanks a lot for all your help! Very much appreciated!

 

[Legacy 323112]

Actually, I can't seem to figure it out! It happens sometimes and not at others..

 

[Legacy 323112]

Hi sorry,
I've realised that every time I run the macro and import the data onto a new (empty) sheet (i.e. if I have just opened the workbook), the columns are misaligned, with the first value being in cell A1.
If I run the macro on a sheet that has been previously used and the data cleared from, the columns are aligned correctly, although the first value is in cell A3. This error occurs consistently. Would you happen to have any suggestions of how to fix this?

 

[baitmaster]

Yep, that's down to this line

wsMyWorksheet.Cells(lastUsedRow(wsMyWorksheet) + 3, 1).Paste

The lastUsedRow function finds the last row with data on it (0 if empty sheet). You need to add 1 at least in order to write data to the next blank cell. I added 3 in order to differentiate between the files, but you can change it how you want

 

[Legacy 323112]

Thanks so much, this works perfectly now!