placing multiple imported sheets into different cells - excel

Question

I am able to import multiple sheets. Each imported file have 2 columns. I want the first file to be placed on Column A and Column B and the second imported file to be placed on Column C and column D on the same sheet.
The following below is my code to import multiple sheets.
Sub ImportFiles()
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Dim path As String
Dim filename As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.AllowMultiSelect = True
'Set the initial path to the C:\ drive.
.InitialFileName = ActiveWorkbook.path
'Add a filter that includes the list.
.Filters.Clear
.Filters.Add "Text Files", "*.txt", 1
'The user pressed the button.
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
path = Left(vrtSelectedItem, InStrRev(vrtSelectedItem, "\"))
filename = Right(vrtSelectedItem, Len(vrtSelectedItem) - InStrRev(vrtSelectedItem, "\"))
Call Importfile(path, filename)
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
End Sub
Sub Importfile(path As String, filename As String)
'Sheets.Add(After:=Sheets("Sheet1")).Name = "RawData"
'ActiveSheet.Name = filename
On Error Resume Next
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & path & filename, Destination:=Range("$A$1"))
.Name = filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileOtherDelimiter = vbTab
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.Refresh BackgroundQuery:=False
End With
End Sub
I did try to place a for loop after "If .Show =-1 Then," such as
Dim FileNames As String
Dim WSNew As Worksheet
For Each filename in FileNames
Set WSNew = ActiveWorkbook.Sheets.Add
Next filename
but it shows an error such that it cant compile it.

Answer 1

Replace your existing procedure with this one:-
Sub Importfile(path As String, filename As String)
Dim Target As Range
Dim C As Long
'Sheets.Add(After:=Sheets("Sheet1")).Name = "RawData"
'ActiveSheet.Name = filename
On Error Resume Next
With ActiveSheet
C = .Cells(1, .Columns.Count).End(xlToLeft).Column
If C > 1 Then C = C + 1
Set Target = .Cells(1, C)
With .QueryTables.Add(Connection:="TEXT;" & path & filename, _
Destination:=Target)
.Name = filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileOtherDelimiter = vbTab
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.Refresh BackgroundQuery:=False
End With
End With
End Sub
Everything remains same as before but the newly imported file will be written to the next free cell in row 1.