Excel VBA . 从多个工作簿复制数据并粘贴到一个工作簿相同的工作表中

我有一个代码，使用户可以打开工作簿并自动将工作表的内容复制到另一个工作簿表 . 如何选择多个工作簿的文件夹并从每个工作簿复制数据并粘贴到同一工作簿的一个工作簿 .

基本上在找到第一个文件后，它应该复制内容并粘贴，然后在其他工作表的内容之后复制另一个文件粘贴 . 以下是我的代码 .

Sub uploadFile()

Application.ScreenUpdating = False  ' disable screen updating

Dim sPath As String   ' Path names in getopenfilename
sPath = "C:\Users\Desktop\November"   

' find the network path
If SetUNCPath(sPath) <> 0 Then

    ' message to show to pick a file
    MsgBox "Select the text file '"
    FileToOpen = Application.GetOpenFilename(Title:="Please choose a file to import")

    ' if the user doens't select a file the sub should terminate and do nothing
    If FileToOpen = False Then
        MsgBox "No file specified.", vbExclamation, "Alert!!!"
            Exit Sub
    Else
      ' Clear contents in Template
      If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False 'Remove Filters if exists
      LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
      If LastRow > 1 Then Worksheets("Data").Range("A2:AL" & LastRow).Clear

      ' open work book and assign splits
      Workbooks.OpenText Filename:= _
      FileToOpen, _
      Origin:=437, StartRow:=1, DataType:=xlFixedWidth, _
      FieldInfo:=Array(Array(0, 1), Array(6, 1), Array(38, 1), Array(45, 1), Array(54, 1), _
      Array(84, 1), Array(91, 1), Array(99, 1), Array(100, 1), Array(106, 1), Array(114, 1), Array(118, 1), Array(121, 1), _
      Array(133, 1), Array(148, 1), Array(151, 1), Array(160, 1), Array(182, 1), _
      Array(190, 1), Array(198, 1), Array(218, 1), Array(219, 1), Array(228, 1), _
      Array(248, 1), Array(260, 1), Array(271, 1), Array(278, 1), Array(289, 1), Array(300, 1), Array(311, 1), Array(315, 1), _
      Array(326, 1), Array(333, 1), Array(340, 1), Array(347, 1), Array(351, 1), Array(357, 1), Array(410, 1)), TrailingMinusNumbers:=True_

      ' splits the path
      SplitPath = Split(FileToOpen, Application.PathSeparator)
      Filename = SplitPath(UBound(SplitPath))

      ' Copy contents from file
      If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False 'Remove Filters if exists
      LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
      Range("A1:AF" & LastRow).Copy

      ' error if file name changes
      Windows("TEMPLATE BPLG.xlsb").Activate
      Sheets("Data").Select 'Select the sheet
      Range("A2").PasteSpecial Paste:=xlPasteValues

      ' Extract the file name of the source file
      SplitPath = Split(FileToOpen, Application.PathSeparator)
      Filename = SplitPath(UBound(SplitPath))
      FileDT = FileDateTime(FileToOpen)

      ' Close the Source file
      Windows(Filename).Activate
      Application.DisplayAlerts = False
      ActiveWindow.Close
      Application.DisplayAlerts = True
      Range("A1").Select

      ' Formulas
      [AG2] = "=Z2/100"
      [AH2] = "=AA2/100"
      [AI2] = "=AB2/100"
      [AJ2] = "=AC2/100"
      [AK2] = "=AD2/100"
      [AL2] = "=AG2-AH2-AI2-AJ2-AK2"

      ' Copy down
      [AG2:AL2].Copy
      LastRow = ActiveSheet.Range("A1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
      Range("AG2:AL" & LastRow).Select
      ActiveSheet.Paste

    End If
End If

' Reset
Sheets("HOME").Select   ' Go to Home
Range("A1").Select      ' go to A1
Application.ScreenUpdating = True 'enable screen updating

' message to display the process is completed
MsgBox "Step complete"

End Sub