vba копировать разрывные диапазоны

Question

Я пытаюсь скопировать ячейки прерывистого диапазона на другой лист.

• мой первый диапазон находится на листе Dati, диапазон A3: G300
• второй диапазон находится на листе Dati,диапазон AA3: AA300

• Третий диапазон находится на листе Dati, диапазон AC3: AC300

• мой пункт назначения находится на листе Calcolo, диапазон A3: I300

• Я хочу использовать объединение (диапазон1, диапазон2, диапазон3), чтобы создать новый диапазон и переместить / скопировать его в диапазон A3: I300 листа Calcolo

Мой код следующий, но есть проблема, потому что на листе назначения "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

Вы почти с вашим кодом.

Если вы копируете на лист Calcolo, замените эту часть своего кода

RangeInc = UnionABC.Value 

следующим:

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

Answer 2

Забудьте буфер обмена и используйте прямую передачу значения с промежуточным массивом вариантов.

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