Excel VBA 将多个范围复制到另一个工作簿中特定 sheet 的代码

Question

我在这里找到了一些代码，可以将我的数据复制到另一个 sheet，它工作正常。我正在尝试扩展它，以便它复制到另一个工作簿和特定工作sheet。

Sub Put_Data()
Dim lastrowDB As Long, lastrow As Long
Dim arr1, arr2, i As Integer

With Sheets("GasMe18-19")
    lastrowDB = .Cells(.Rows.Count, "A").End(xlUp).row + 1
End With

arr1 = Array("A", "G", "H", "L")
arr2 = Array("Q", "R", "S", "T")

For i = LBound(arr1) To UBound(arr1)
    With Sheets("GasMe18-19")
         lastrow = Application.Max(4, .Cells(.Rows.Count,   arr1(i)).End(xlUp).row)
         .Range(.Cells(4, arr1(i)), .Cells(lastrow, arr1(i))).Copy
         Sheets("Sheet1").Range(arr2(i) & 2).PasteSpecial xlPasteValues
    End With
Next
Application.CutCopyMode = False
End Sub

如何修改以将数据范围放入另一个工作簿？我将 Sheet1 放在家庭工作簿中，一切看起来都很好，我喜欢现有的代码库。原始 Workbook.Worksheet 有 4 列数据，我每隔几天就会添加这些数据。然后我复制并粘贴到另一个 Workbook2.WorkSheet2 中进行绘图。我更喜欢复制从第 4 行到 4 列数据的最后一行的所有内容。

Answer 1

您需要使用相关工作簿限定您的范围

Dim wbSource As Workbook, wbTarget As Workbook
Set wbSource = ThisWorkbook
Set wbTarget = Workbooks("TheTargetWBName")

...

For i = LBound(arr1) To UBound(arr1)
    With wbSource.Worksheets("GasMe18-19")
         lastrow = Application.Max(4, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
         .Range(.Cells(4, arr1(i)), .Cells(lastrow, arr1(i))).Copy
         wbTarget.Worksheets("Sheet1").Range(arr2(i) & 2).PasteSpecial xlPasteValues
    End With
Next

请注意 sheets("Sheet1").Range(arr2(i) & 2).PasteSpecial xlPasteValues 行现在如何使用先前声明的变量 wsTarget 完全符合目标工作簿。此变量首先使用以下行设置为工作簿的名称：

Set wbTarget = Workbooks("TheTargetWBName")

如果目标工作簿没有打开，那么你只需更改为

Set wbTarget = Workbooks.Open("TheTargetWBName")

Excel VBA 将多个范围复制到另一个工作簿中特定 sheet 的代码

Excel VBA code to copy several ranges to specific sheet in another workbook

excel

vba

worksheet