复制粘贴多个范围 VBA

Question

我正在尝试将粘贴值从一个工作簿复制到另一个工作簿。我想指定多个范围，这样我就可以避免为每个范围使用一个变量。我使用以下对我不起作用的简化代码：

Sub Gather()

Dim y As Workbook

'## Setting variables ##
 Dim Contractual_flow_mat_C66_r460_470_c120_130_140 As Variant


'## Open Workbooks ##

  Set y = Workbooks.Open("Y")

'## Store values ##

    Contractual_flow_mat_C66_r460_470_c120_130_140 = y.Sheets("66").Range("P56:R57", "P62:R68", "P72:R74")

'## Input the values ##

    ThisWorkbook.Sheets("Denominator").Range("D48:F49", "D51:F57", "D59:F61") = Contractual_flow_mat_C66_r460_470_c120_130_140

'## Other ##

y.Close

End Sub

我在这一行收到错误“参数数量错误或属性分配无效”：

Contractual_flow_mat_C66_r460_470_c120_130_140 = y.Sheets("66").Range("P56:R57", "P62:R68", "P72:R74")

Answer 1

除了保存源工作簿参考之外，您根本不需要使用任何变量：

Sub Gather()

  Dim y As Workbook
  Set y = Workbooks.Open("Y")

  ThisWorkbook.Sheets("Denominator").Range("D48:F49").Value2 = y.Sheets("66").Range("P56:R57").Value2
  ThisWorkbook.Sheets("Denominator").Range("D51:F57").Value2 = y.Sheets("66").Range("P62:R68").Value2
  ThisWorkbook.Sheets("Denominator").Range("D59:F61").Value2 = y.Sheets("66").Range("P72:R74").Value2

  y.Close

End Sub

现在，您可以将变量用于工作表引用，而且您应该这样做。 ThisWorkbook 可以改变你，尤其是在打开新工作簿时：

Sub Gather2()

  On Error GoTo ErrorHandler
  Dim destSheet As Worksheet
  Set destSheet = ThisWorkbook.Sheets("Denominator")

  Dim sourceBook As Workbook
  Set sourceBook = Workbooks.Open("Y")
  Dim sourceSheet As Worksheet
  Set sourceSheet = sourceBook.Sheets("66")

  destSheet.Range("D48:F49").Value2 = sourceSheet.Range("P56:R57").Value2
  destSheet.Range("D51:F57").Value2 = sourceSheet.Range("P62:R68").Value2
  destSheet.Range("D59:F61").Value2 = sourceSheet.Range("P72:R74").Value2

CleanExit:
  If Not sourceBook Is Nothing Then
    sourceBook.Close
  End If

  Exit Sub

ErrorHandler:
  MsgBox ("Failed to open workbook 'y'")
  Resume CleanExit

End Sub

我在那里为你添加了一些错误处理，以防“Y”不存在。

下一步是为您的实际范围地址添加一些变量，以便您可以循环访问它们，以防您需要复制更多范围，或者如果范围发生变化（源或目标）。

Answer 2

一般来说，如果您像这样声明范围，您的代码应该更进一步：

With Worksheets(1)
    Set someSource = .Range("P56:R57, P62:R68, P72:R74")
End With

With Worksheets(2)
    Set someTarget = .Range("D48:F49, D51:F57, D59:F61")
End With

因此，每个范围需要少一个"。如果您想按照自己的方式进行操作，棘手的部分是使用范围联合的.Areas 属性并循环遍历它。因此，尝试这样：

Sub TestMe()

    Dim someSource      As Range
    Dim someTarget      As Range
    Dim rng1            As Range
    Dim rng2            As Range

    With Worksheets(1)
        Set someSource = Union(.Range("P56:R57"), .Range("P62:R68"), .Range("P62:R68"))
    End With

    With Worksheets(2)
        'Without a Union(), but the same:
        Set someTarget = .Range("D48:F49, D51:F57, D59:F61")
    End With

    Dim cnt1 As Long
    Dim cnt2 As Long

    For Each rng1 In someSource.Areas
        cnt1 = cnt1 + 1
        For Each rng2 In someTarget.Areas
            cnt2 = cnt2 + 1
            If cnt1 = cnt2 Then
                rng2.Value = rng1.Value
            End If
        Next rng2
        cnt2 = 0
    Next rng1

End Sub

我已经简化了任务，要求它将范围从第一个工作表复制到第二个工作表。总的来说是一样的。

在嵌套循环中，我们的想法是我们有两个集合，我们应该确保：

• 工作表中的区域 1(2).Values = 工作表中的区域 1(1).Values
• 工作表中的区域 2(2).Values = 工作表中的区域 2(1).Values
• 工作表中的区域 3(2).Values = 工作表中的区域 3(1).Values

编辑： 如果你不喜欢嵌套循环的 O(n^2) 复杂度，你可以使用区域的 .Item(value) 来实现线性循环：

Dim cnt     As Long
For cnt = 1 To someSource.Areas.Count
    Debug.Print someSource.Areas.Item(cnt).Address
    Debug.Print someTarget.Areas.Item(cnt).Address
    someTarget.Areas.Item(cnt).Value = someSource.Areas.Item(cnt).Value
Next cnt