複製並粘貼多個範圍，而不使用使用VBA

Question

剪貼板

我成功地從一個範圍值複製下面的代碼：

Dim wb As Workbook, strFile As String, rSrc As Range, rDst As Range, r1 As Range, r2 As Range, r3 As Range, r As Range 
Set wb = ActiveWorkbook 

'pasting Summary values 

    Set wkbTemp = Workbooks.Open(ThisWorkbook.Path & "\data\Summary.csv") 
     LastRow = Cells(Rows.Count, "B").End(xlUp).Row 
     Set rSrc = wkbTemp.Sheets(1).Range("b2:G" & LastRow) 
     wb.Activate 
     Set rDst = wb.Sheets("Summary").Cells(6, 4).Resize(rSrc.Rows.Count, rSrc.Columns.Count) 
     rDst = rSrc.Value 

我也想多範圍從同一工作表複製，但它崩潰當我設置源的範圍用以下代碼：

'PY to Comparison 
    With wkbTemp.Sheets(1) 

    Set r1 = .Range("B2:B" & LastRow) 
    Set r2 = .Range("d2:d" & LastRow) 
    Set r3 = .Range("f2:g" & LastRow) 
    Set r = Union(r1, r2, r3) 
    Set rSrc = .Range(r) 

    End With 

    wb.Activate 
    Set rDst = wb.Sheets("Comparison").Cells(9, 6).Resize(rSrc.Rows.Count, rSrc.Columns.Count) 
    rDst = rSrc.Value 

上述的方法來複制多個範圍得到了它從下面的鏈接Copy multiple ranges with VBA

我也試圖複製使用行（但我真正需要的是動態的長度）的預定長度的範圍，但我的代碼只複製第一個範圍：

Set rSrc = wkbTemp.Sheets(1).Range("B2:B6,d2:d6,f2,g6") 

    wb.Activate 
    Set rDst = wb.Sheets("Comparison").Cells(9, 6).Resize(rSrc.Rows.Count, rSrc.Columns.Count) 
    rDst = rSrc.Value 

我在做什麼錯？

Answer 1

像這樣的東西應該工作：

'... 
With wkbTemp.Sheets(1) 
    Set r1 = .Range("B2:B" & LastRow) 
    Set r2 = .Range("d2:d" & LastRow) 
    Set r3 = .Range("f2:g" & LastRow) 
    Set r = Union(r1, r2, r3) 
End With 

CopyRangeValue r, wb.Sheets("Comparison").Cells(9, 6) 
'.... 

CopyRangeValue子看起來是這樣的：

'copy a range (can be multi-area) value to a different range 
Sub CopyRangeValue(rngCopy As Range, rngDest As Range) 
    Dim a As Range 
    For Each a In rngCopy.Areas 
     rngDest.Resize(a.Rows.Count, a.Columns.Count).Value = a.Value 
     Set rngDest = rngDest.Offset(0, a.Columns.Count) 
    Next a 
End Sub