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“主”工作簿中。无论出于何种原因，仅复制文件夹中最后一个工作簿中的数据。

非常感谢您的帮助！

将多个工作簿合并为一个

0 个答案: