Question

我正在尝试将不连续的范围单元格复制到另一张纸上。

我的第一个范围是Dati，范围A3：G300
第二个范围在工作表Dati上，范围AA3：AA300
第三页在Dati上，范围AC3：AC300
我的目的地在工作表Calcolo上，范围为A3：I300
我想使用union（range1，range2，range3）创建一个新范围并将其移动/复制到Calcolo表的范围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)

vba复制不连续范围单元格

2 个答案: