vba复制不连续范围单元格

Question

我正在尝试将不连续的范围单元格复制到另一个工作表。

• 我的第一个范围在 Dati 表上，范围 A3:G300
• 第二个范围在数据表上，范围 AA3:AA300

• 第三个范围在数据表上，范围 AC3:AC300

• 我的目的地在 Calcolo 表上，范围 A3:I300

• 我想使用 union(range1, range2, range3) 创建一个新范围并将其移动/复制到 Calcolo sheet 的 A3:I300 范围

我的代码如下，但存在问题，因为在目标表“Calcolo”上，从 A3 到 G300 的数据是正确的，而从 H3 到 I300 我的数据没有被考虑为 #N/D 值。

Sub copia()

Dim SelectA As Range
Dim SelectB As Range
Dim SelectC As Range
Dim UnionABC As Range
Dim RangeInc As Range

Set SelectA = Sheets("Dati").Range("A3:G300")
Set SelectB = Sheets("Dati").Range("AA3:AA300")
Set SelectC = Sheets("Dati").Range("AC3:AC300")
Set UnionABC = Union(SelectA, SelectB, SelectC)
Set RangeInc = Sheets("Calcolo").Range("A3:I300")

RangeInc = UnionABC.Value

End Sub

任何帮助查找错误或重新编码的想法？ 谢谢

Answer 1

忘记剪贴板，使用中间变量数组的直接值传输。

sub copia2()

    dim arr as variant, tmp as variant, i as long

    with workSheets("Dati")
        arr = .Range("A3:G300").value

        'collect AA
        tmp = .Range("AA3:AA300").value
        'make room for AA
        redim preserve arr(lbound(arr, 1) to ubound(arr, 1), _
                           lbound(arr, 2) to ubound(arr, 2) + 1)
        'transfer AA
        for i = lbound(arr, 1) to ubound(arr, 1)
            arr(i, ubound(arr, 2)) = tmp(i, 1)
        next i

        'collect AC
        tmp = .Range("AC3:AC300").value
        'make room for AC
        redim preserve arr(lbound(arr, 1) to ubound(arr, 1), _
                           lbound(arr, 2) to ubound(arr, 2) + 1)
        'transfer AC
        for i = lbound(arr, 1) to ubound(arr, 1)
            arr(i, ubound(arr, 2)) = tmp(i, 1)
        next i

    end with

    with workSheets("Calcolo")

       'transfer values to destination
        .Range("A3").resize(ubound(arr, 1), ubound(arr, 2)) = arr

    end with

end sub

Answer 2

您的代码就快到了。

复制到工作表 Calcolo 的地方，替换代码的那部分

RangeInc = UnionABC.Value 

以下内容：

UnionABC.Copy Destination:=Sheets("Calcolo").Range(RangeInc.Address)