问将多个导入的工作表放置到不同的单元格中

EN

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

Dim FileNames As String
Dim WSNew As Worksheet

For Each filename in FileNames
Set WSNew = ActiveWorkbook.Sheets.Add
Next filename