Скопируйте несколько диапазонов и вставьте - PullRequest
0 голосов
/ 20 июня 2019

РЕДАКТИРОВАТЬ: я забыл поставить весь код.

Я пытаюсь скопировать 2 диапазона и вставить их на другой лист, но я получаю эту ошибку:

Объектпеременная или с блочной переменной не установлена ​​

Код:

Sub Test()

    Dim R1 As Range
    Dim R2 As Range
    Dim mRange As Range
    Dim C As Range
    Dim LastRow As Integer

    LastRow = Sheets("Errors").Range("A" & Rows.Count).End(xlUp).Row

    Set R1 = Range("D5:N5")
    Set R2 = Range("B8")
    Set mRange = Union(R1, R2)

    For Each C In mRange.Areas

        C.Copy
        Worksheets("Errors").Range("A" & LastRow + 1).Paste

    Next C

End Sub

Заранее спасибо!

Ответы [ 2 ]

0 голосов
/ 20 июня 2019

Вы можете попробовать:

Sub Test()

    Dim R1 As Range
    Dim R2 As Range
    Dim mRange As Range
    Dim C As Range
    Dim LastRow As Long 'Change "Integer" to "Long" because "Long could take a high value in case you have vast amount of data

    With ThisWorkbook 'Add "ThisWorkbook." to avoid conflicts if you have open more than one workbook

        With .Worksheets("Sheet1") 'Declare from which sheet you want to set ranges
            Set R1 = .Range("D5:N5")
            Set R2 = .Range("B8")
            Set mRange = Union(R1, R2)
        End With

        For Each C In mRange.Areas

            C.Copy

            With .Worksheets("Errors")
                'Lastrow should be calculated here in order to get the new last row every time you paste something
                LastRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
            End With

        Next C

    End With

End Sub
0 голосов
/ 20 июня 2019

Вы не добавили диапазоны в mRange, а затем пытаетесь получить к нему доступ.

Добавьте диапазоны к mRange:

Sub Test()

    Dim R1 As Range
    Dim R2 As Range
    Dim mRange As Range
    Dim C As Range
    Dim LastRow as Integer

    LastRow = Sheets("Errors").Range("A" & Rows.Count).End(xlUp).Row

    Set R1 = Range("D5:N5")
    Set R2 = Range("B8")

    Set mRange = Union(R1, R2)

    For Each C In mRange.Areas

        C.Copy Worksheets("Errors").Range("A" & LastRow + 1)

    Next C

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...