復制多個范圍並粘貼

Question

編輯：我忘了把所有的代碼。

我正在嘗試復制 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

提前致謝 ！

Answer 1

您尚未向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

Answer 2

你可以試試：

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