Консолидация нескольких рабочих книг в одну

Question

Я пытаюсь объединить данные из нескольких рабочих книг в одну главную книгу.Все рабочие книги, включая основную рабочую книгу, имеют одинаковые рабочие таблицы.Данные в таблицах, однако, отличаются.Каждая рабочая тетрадь создается из вопросов одного и того же опроса.Я пытаюсь объединить все ответы на опросы в одну рабочую книгу.

Код:

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lastRowNumber As Double
Dim lastColumnNumber As Double
Dim theLastCell As String
Dim copyRange  As Range
Dim pasteRange As Range
Dim sheetName As String
Dim copyRangeString As String
Dim pasteRangeString As String

   Do While myFile <> ""
      Set wb = Workbooks.Open(FileName:=myPath & myFile)
      DoEvents
      wb.Worksheets(1).Range("A2:D2").Interior.color = RGB(51, 98, 174)




For i = 1 To 8
    lastRowNumber = lastRowUsed(wb.Sheets(i))
    lastColumnNumber = wb.Sheets(i).Range("A1").SpecialCells(xlCellTypeLastCell).Column
    theLastCell = Cells(lastRowNumber, lastColumnNumber).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Set copyRange = wb.Worksheets(i).Range("A2:" & theLastCell)
    copyRangeString = "A2:" & theLastCell
    lastRowNumber = lastRowUsed(theWorkbook.Sheets(i)) + lastRowUsed(wb.Sheets(i))
    pasteRangeString = "A" & lastRowNumber & ":" & theLastCell
    theWorkbook.Sheets(i).Range(pasteRangeString) = wb.Sheets(i).Range(copyRangeString).value
    copyRangeString = ""
    pasteRangeString = ""
    sheetName = wb.Sheets(i).name
    MsgBox sheetName

Next

  wb.Close
  DoEvents
  myFile = dir
   Loop

Я пытаюсь сделать это, просматривая каждый файл Excel в папке, просматривая (1-8) из рабочих листов.Создание диапазона данных в каждом рабочем листе, а затем копирование и вставка в theWorkbook «главную» рабочую книгу.По какой-то причине копируются только данные из последней книги в папке.

Любая помощь очень ценится!