I need a macro/VBA to import a selection of multiple .txt files into multiple worksheets. When I use the code shown below it works great but it creates a new sheet for each file and uses the imported file name to name the sheet that is created. I need to import the .txt files into pre-existing sheets and retain the original sheet names. For example I'd like to import 10 .txt files into pre-defined sheets named "Part 1", "Part 2", "Part 3"....etc.
I'm not well versed in VBA but I believe the code below could be modified to achieve the described results, any help would be greatly appreciated. Thanks!
Also, I may not need to always import 10 .txt files, sometimes it may be 5 or 2 or even 1, etc. How do I import them in sequential order?
I'm not well versed in VBA but I believe the code below could be modified to achieve the described results, any help would be greatly appreciated. Thanks!
Also, I may not need to always import 10 .txt files, sometimes it may be 5 or 2 or even 1, etc. How do I import them in sequential order?
VBA 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
Last edited: