复制多个范围并粘贴

时间:2019-06-20 04:42:29

标签: excel vba

编辑:我忘了输入所有代码。

我正在尝试复制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 :(得分:0)

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

答案 1 :(得分:0)

您可以尝试:

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