Appending TXT files in VBA and opening in Excel - excel

Question

Newbie here.
So I have a dozen of these TXT/DTA files that look something like this and I want to stack them side by side. I want each file appended to the right, merged into one big file
Not knowing much about VBA I looked around and merged a few codes that seems to do it for xlsx files but doesn't for DTA files which is what I have. The code asks for a folder and loops through the files one by one.
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
'---Open the first file only
Workbooks.Open (MyFile)
Workbooks(MyFile).Worksheets("Sheet1").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Workbooks("CV Combined.xlsm").Worksheets("Sheet1").Range("A1")
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(fileName:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
Workbooks.Open (MyFile)
Workbooks(MyFile).Worksheets("Sheet1").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy Workbooks("CV Combined.xlsm").Worksheets("Sheet1").Range("A1").End(xlToRight).Offset(0, 1)
Workbooks(MyFile).Close SaveChanges:=False
wbk.Close SaveChanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub
Any help would be appreciated.

Answer 1

MyFile = Dir(MyFolder) returns only the filename in MyFile so to open the first file use Workbooks.Open (MyFolder & MyFile). When the text file is opened the sheet name is the filename so Workbooks(MyFile).Worksheets("Sheet1") needs to be Workbooks(MyFile).sheets(1). Because your text file only has data in column A on row 1 Selection.End(xlToRight) will go the last column on the sheet XFD1 and then Selection.End(xlDown) will go to the last row XFD1048576.
Option Explicit
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbDTA As Workbook 'Used to loop through each workbook
Dim ws As Worksheet, wsDTA As Worksheet, rng As Range
Dim iCol As Long, n As Long
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
Set ws = Workbooks("CV Combined.xlsm").Sheets(1)
iCol = 1
'Loop through all files in a folder until DIR cannot find anymore
Application.ScreenUpdating = False
MyFile = Dir(MyFolder)
Do While MyFile <> ""
Set wbDTA = Workbooks.Open(MyFolder & MyFile, False, False)
Set wsDTA = wbDTA.Sheets(1)
Set rng = wsDTA.UsedRange
rng.Copy ws.Cells(1, iCol)
iCol = iCol + rng.Columns.Count + 1 ' add blank column
n = n + 1
wbDTA.Close SaveChanges:=False
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
MsgBox n & " files imported from " & MyFolder, vbInformation
End Sub