复制并粘贴多个范围，而不使用使用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