L
Legacy 323112
Guest
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!
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!
Code:
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
