連番フォルダ内の同一ファイル名のエクセルファイルを一つのシートにまとめる

Visual Basic for Applications

Sub Macro()
  Dim Sheet As Integer
  Dim rrr As Integer
  Dim ccc As Integer
  Dim StartFolderNumber As Integer
  Dim EndFolderNumber As Integer
  Dim ObjNetWork As Object
  Dim GetUserName As String
  Dim DataFile As String
  Dim FilePath As String
  Dim OpenFile As String
  Dim EndRow As Integer
  Dim EndCol As Integer
  Sheet = 1
  rrr = 1
  ccc = 1
  StartFolderNumber = 1 'Folder Number、先頭
  EndFolderNumber = 5 'Folder Number、最後
  DataFile = "Example.xls" 'エクセルファイル名
  Set ObjNetWork = CreateObject("WScript.Network")
    GetUserName = ObjNetWork.UserName
  Set ObjNetWork = Nothing
  ThisWorkbook.Activate
  Worksheets(Sheet).Activate
  Cells.Select
  Selection.ClearContents
  Application.DisplayAlerts = False
    For nnn = StartFolderNumber To EndFolderNumber
      FilePath = "C:\Users\" & GetUserName & "\Desktop\ExampleFolder" & CStr(nnn) & "\"
      OpenFile = FilePath & DataFile
      Workbooks.Open OpenFile
      Workbooks(DataFile).Activate
      EndRow = Worksheets(Sheet).Cells(1, 1).End(xlDown).Row
      EndCol = Worksheets(Sheet).Cells(1, 1).End(xlToRight).Column
      Range(Cells(1, 1), Cells(EndRow, EndCol)).Select
      Selection.Copy
      ThisWorkbook.Activate
      Worksheets(Sheet).Cells(rrr, ccc).Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Workbooks(DataFile).Close
      rrr = rrr + EndRow
      DoEvents
    Next
  Application.DisplayAlerts = True
  ThisWorkbook.Save
End Sub