将多个范围从工作表复制到另一个工作表

Question

我试图将多个单元格从一个工作表复制到另一个。 我收到错误消息，错误的参数数量或无效的属性分配。

Range("D10:D12,D15,D22,D25,D32:D33,D38:D42,D47:D50,D53,D55,D57,D63").Select
Range("G3").Select
Selection.Copy
Sheets("Sheet3").Select
'Range("I4").End(xlUp).Select
lMaxRows = Cells(Rows.Count, "I", "AD").End(xlUp).Row
Range("I", "AD" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
Sheets("Sheet1").Select
Range("I4", "AD").Select

希望能为您提供帮助。

---

我尝试使用工会，但无法提出解决方案。 这是我现在拥有的代码

Dim r1 As Range, r2 As Range, multiRange As Range

Set r1 = Sheets("Sheet1").Range("D10:D12,D15,D22,D25,D32:D33,D38:D42,D47:D50,D53,D55,D57,D63")
Set r2 = Sheets("Sheet1").Range("G3")
Set multiRange = Union(r1, r2)
Application.Union(r1, r2).Select
Selection.Copy
Sheets("Sheet3").Select
'Range("I4").End(xlUp).Select
lMaxRows = Cells(Rows.Count, "I").End(xlUp).Row
Range("I" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
Sheets("Sheet1").Select
Range("I4").Select

我知道收到的错误消息是该命令不能用于多个选择。 突出显示的代码是SELECTION.COPY

Answer 1

下面的代码假定Sheets（“ Sheet1”）的工作表代号为“ Sheet1”，而Sheet3与此类似。 （通常，应在代码中使用工作表CodeName）。

Dim SourceArea As Range
Dim TargetArea As Range
Dim CopyRange As Range

Set CopyRange = Sheet1.Range("D10:D12,D15,D22,D25,D32:D33,D38:D42,D47:D50,D53,D55,D57,D63")

For Each SourceArea In CopyRange.Areas
    Set TargetArea = Sheet3.Range(SourceArea.Address)
    TargetArea.Value = SourceArea.Value
Next

编辑：以上内容将粘贴在Sheet3中与Sheet1范围完全相同的位置。 如果要粘贴到其他位置，请使用“偏移”。 例如，如果您希望目标中的左上方单元格为I20，则：

Set TargetArea = Sheet3.Range(SourceArea.Address).Offset(10,5)