使用 VBA 在不使用剪贴板的情况下复制和粘贴多个范围答案

【问题标题】：Copy and paste multiple ranges without using the clipboard using VBA使用 VBA 在不使用剪贴板的情况下复制和粘贴多个范围
【发布时间】：2017-07-16 05:55:39
【问题描述】：

我使用以下代码成功地从单个范围复制值：

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

我做错了什么？

【问题讨论】：

rSrc 将包含 3 个Areas。 AFAIK，如果您不指定使用哪一个，默认将使用rSrc.Areas(1).Value。
你不能那样做 - 你需要使用循环。
蒂姆是对的。遍历 Areas 集合 - 每个 Area 都是一个连续的范围
r 已经是一个范围，所以你不能说 set srcrg=.range(r) 。下次使用选项显式。抛弃r，直接设置srcrg=union(....)。但是你需要测试一下 srcrg 是不是也没什么......
@chrisneilsen 我正在尝试这样做，但我做错了什么。请在下面查看我的代码

标签： vba excel range

【解决方案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)
'....

CopyRangeValueSub 看起来像这样：

'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

【讨论】：