Question

我需要复制相同的范围（L18：L22）从工作簿1中的所有工作表，然后将数据粘贴到工作簿2的Sheet1中。来自第一个工作表的数据将进入A列的第一个空单元格，来自第二个工作表的数据将进入B列的第一个空单元格......等等。我只能从一个工作表中复制数据，并试图为所有工作表执行此操作。

它只从我的工作表“M-025”复制，但在尝试修改它以复制所有工作表中的相同范围时我遇到了困难。

Sub TorqueData()

    Dim sBook_t As String
    Dim sBook_s As String
    Dim sSheet_t As String
    Dim sSheet_s As String

    sBook_t = "Opta Comms Export.xlsm"
    sBook_s = "Master Calibration Data - Num10.xlsm"
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    sSheet_s = "Sheet1"
    sSheet_t = "M-025"
    Workbooks(sBook_t).Sheets(sSheet_t).Range("L18:L22").Copy
    Workbooks(sBook_s).Sheets(sSheet_s).Range ("A" & lMaxRows + 1)
End Sub

Answer 1

检查以下代码。我按照你的要求写了。如果没有测试代码，请进行微调。

Sub TorqueData()
Dim wbSrc As Workbook
Dim wbDest As Workbook
Dim lastrow As Long

Set wbDest = Workbooks.Open("Master Calibration Data - Num10.xlsm")
Set wbSrc = Workbooks.Open("Opta Comms Export.xlsm")

lastrow = 1
wbSrc.Activate
For Each sh In wbSrc.Sheets

     wbSrc.Sheets(sh).Range("L18:L22").Copy
     wbDest.Sheets("Sheet1").Activate
     lastrow = wbDest.Sheets("Sheet1").Range("A" & .Rows.Count).End(xlUp).Row + 1
     wbDest.Sheets("Sheet1").Range("A" & lastrow).PasteSpecial xlPasteValues

Next


End Sub

宏将一本书中的多个工作表中的数据复制到另一本书的一张表中

1 个答案: