复制粘贴多个范围的VBA

Question

I'm trying to copy paste values from one workbook to another. I would like to specify multiple ranges so I can avoid using one variable for each range. I use the below simplified code that doesn't work for me:

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

I get the error "Wrong number of arguments or invalid property assignment" on this row:

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

Answer 1

You don't need to use any variables at all other than to hold your source workbook reference:

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

Now, you can use variables, and you should, for your worksheet references. ThisWorkbook can change on you, especially when opening new workbooks:

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

I added a bit of error handling in there for you, just in case 'Y' doesn't exist.

The next step is to add some variables for your actual range addresses so you can loop through them in case you ever need to copy more ranges, or if the ranges ever change (either source or destination).

Answer 2

In general, your code should work one step further, if you declare the ranges like this:

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

Thus, you need one less " per range. If you want to do it your way, the tricky part is to use the .Areas property of a Union of ranges and to loop through it. Thus, try like this:

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

I have simplified the task, asking it to copy ranges from the first worksheet to the second one. In general it is quite the same.

In the nested loop, the idea is that we have two collections with which we should make sure, that:

• Area 1 from the worksheet(2).Values = Area 1 from worksheet(1).Values
• Area 2 from the worksheet(2).Values = Area 2 from worksheet(1).Values
• Area 3 from the worksheet(2).Values = Area 3 from worksheet(1).Values

Edit: And if you dislike the nested loops for their O(n^2) complexity, you may use the .Item(value) of the Areas for a linear one:

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