CODEWITHSUNDEEP
vbaexcelrange
janf
janf

Reputation: 81

Copy and paste multiple ranges without using the clipboard using VBA

I am successfully copying values from a single range with the following code :

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

I am also trying to copy multiple ranges from the same sheet but it crashes when I set the range of the source with the following code:

'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

The above way to copy multiple ranges got it from the following link Copy multiple ranges with VBA

I also tried to copy the ranges using predefined length of rows (but what I really need is dynamic length), but my code only copies the first range:

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

What am I doing wrong?

Upvotes: 0

Views: 1277

Answers (1)

Tim Williams
Tim Williams

Reputation: 166306

Something like this should work:

'...
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 Sub looks like this:

'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

Upvotes: 1

Related Questions