如何使用VBA将不同Excel选项卡中的数据合并到主控表中

我正在使用下面的脚本将数据从多页Excel文件的“Sheet1”复制到另一个Excel文件的主控表中。它在一张纸上工作得很好。现在我需要让它运行所有的工作表，将数据粘贴到主文件中的下一行

请注意：所有工作表使用相同的密码

请帮忙

谢谢

约哈南

Sub CopyRanges()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim LastRow As Long

Set WB1 = ActiveWorkbook
Set WB2 = Workbooks.Open(WB1.Path & "\Datafile.xls")

Sheets("Sheet1").Unprotect ("Password1")

With WB2.Sheets("Sheet1")
  LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
WB2.Sheets("71235").Range("B6:M" & LastRow).Copy
WB1.Sheets("Output").Range("A2").PasteSpecial xlPasteValues

Sheets("Sheet1").Protect ("FTCCTOR")
WB2.Close
End Sub

试试这个：

Sub CopyRanges()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim LastRow As Long
Dim sht As Worksheet

Set WB1 = ActiveWorkbook
Set WB2 = Workbooks.Open(WB1.Path & "\Datafile.xls")

For Each sht In WB2.Sheets
    With sht
        .Unprotect ("Password1")
        LastRow = .Range("B" & .Rows.count).End(xlUp).Row
        WB1.Sheets("Output").Range("A" & WB1.Sheets("Output").Rows.count).End(xlUp).Resize(LastRow - 5, 12).value = .Range("B6:M" & LastRow).value
        .Protect ("Password1")
    End With
Next sht
WB2.Close
End Sub

当只需要值时，分配值比复制值更快。

尝试以下方法：

Sub CopyRanges()
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim LastRow As Long
Dim sht As Worksheet

Set WB1 = ActiveWorkbook
Set WB2 = Workbooks.Open(WB1.Path & "\Datafile.xls")

For Each sht In WB2.Sheets
    With sht
        .Unprotect ("Password1")
        LastRow = .Range("B" & .Rows.count).End(xlUp).Row
        WB1.Sheets("Output").Range("A" & WB1.Sheets("Output").Rows.count).End(xlUp).Resize(LastRow - 5, 12).value = .Range("B6:M" & LastRow).value
        .Protect ("Password1")
    End With
Next sht
WB2.Close
End Sub

当只需要值时，分配值比复制值更快