Excel 尝试复制联合时出现运行时错误

我目前正在为excel编写VBA，得到1004条信息：“该命令不能用于多项选择”。我的代码选择excel文件中的多个列（非连续），并将它们作为一个范围合并。然后复制范围并粘贴到另一张图纸上。我有一些潜艇可以为不同的报告这样做。第一个报告运行正常，但是当第二个报告尝试运行时，我得到了运行时错误。当我选择“Debug”时，它会将我带到range.copy行

我该怎么办

代码如下：

Option Explicit
Public wsSheet As Worksheet
Public wbMaster As Workbook
Public wbReport As Workbook
Public rngPartNumber As Range
Public rngPartName As Range
Public rngSupplier As Range
Public rngTPRStatus As Range
Public rngOffTool As Range
Public rngExceptionNotes As Range
Public rngMRD As Range

Sub RunReports()

    Set wbMaster = ActiveWorkbook
    Set wsSheet = wbMaster.Sheets("Part x Part Matrix")
    With wsSheet
        .AutoFilterMode = False
        SetRanges
    End With

    TPRReport
    ExceptionsReport1

    wsSheet.ShowAllData

End Sub

Sub SetRanges()

    wsSheet.Activate
    Set rngPartNumber = Range("C:C")
    Set rngPartName = Range("H:H")
    Set rngSupplier = Range("Q:R")
    Set rngTPRStatus = Range("X:Y")
    Set rngOffTool = Range("Z1", Range("AC1").End(xlDown))
    Set rngExceptionNotes = Range("AH1", Range("AH1").End(xlDown))
    Set rngMRD = Range("AI1", Range("AK1").End(xlDown))
End Sub

Sub TPRReport()

Dim rngTPRResults As Range

    wsSheet.Range("A1").End(xlToRight).AutoFilter Field:=24, Criteria1:="No"
    Set rngTPRResults = Union(rngPartNumber, rngPartName, rngSupplier, rngTPRStatus)
    rngTPRResults.Copy

    Set wbReport = Workbooks.Add
    With wbReport.Worksheets("Sheet1")
        .Range("A1").Select
        .Paste
        .SaveAs Filename:=wbMaster.Path & "\TPR Report" & Format(CStr(Now), "yyyymmdd_hhmm")
    .Close
    End With

End Sub

Sub ExceptionsReport1()
Dim rngExceptions As Range

    wsSheet.Range("A1").End(xlToRight).AutoFilter Field:=38, Criteria1:="X"
    Set rngExceptions = Union(rngPartNumber, rngPartName, rngSupplier, rngTPRStatus, rngOffTool, rngExceptionNotes, rngMRD)
    rngExceptions.Copy

    Set wbReport = Workbooks.Add
    With wbReport.Worksheets("Sheet1")
        .Range("A1").Select
        .Paste
        .SaveAs Filename:=wbMaster.Path & "\Exceptions Report CV" & Format(CStr(Now), "yyyymmdd_hhmm")
    .Close
    End With

End Sub

---

将工作表传递给子过程，并使用它来限定所有父工作表引用

Sub RunReports()

    Set wbMaster = ActiveWorkbook
    Set wsSheet = wbMaster.Sheets("Part x Part Matrix")
    With wsSheet
        if .AutoFilterMode then .AutoFilterMode = False
        SetRanges .cells(1).parent
    End With

    ...

End Sub

Sub SetRanges(ws as worksheet)
    with ws
        Set rngPartNumber = .Range("C:C")
        Set rngPartName = .Range("H:H")
        Set rngSupplier = .Range("Q:R")
        Set rngTPRStatus = .Range("X:Y")
        Set rngOffTool = .Range("Z1", .Range("AC1").End(xlDown))
        Set rngExceptionNotes = .Range("AH1", .Range("AH1").End(xlDown))
        Set rngMRD = .Range("AI1", .Range("AK1").End(xlDown))
    end with
End Sub

---

将工作表传递给子过程，并使用它来限定所有父工作表引用

Sub RunReports()

    Set wbMaster = ActiveWorkbook
    Set wsSheet = wbMaster.Sheets("Part x Part Matrix")
    With wsSheet
        if .AutoFilterMode then .AutoFilterMode = False
        SetRanges .cells(1).parent
    End With

    ...

End Sub

Sub SetRanges(ws as worksheet)
    with ws
        Set rngPartNumber = .Range("C:C")
        Set rngPartName = .Range("H:H")
        Set rngSupplier = .Range("Q:R")
        Set rngTPRStatus = .Range("X:Y")
        Set rngOffTool = .Range("Z1", .Range("AC1").End(xlDown))
        Set rngExceptionNotes = .Range("AH1", .Range("AH1").End(xlDown))
        Set rngMRD = .Range("AI1", .Range("AK1").End(xlDown))
    end with
End Sub

基于from，以下代码将复制非连续数据，而不复制不属于联合的单元格

Sub CopyAreas(ByVal Source As Range, _
              ByVal Target As Range, _
              Optional ByVal Inline As Boolean)
    Dim area As Range

    If Inline Then
        For Each area In Source.Areas
            area.Copy Destination:=Target
            Set Target = Target.Offset(area.Rows.Count)
        Next
    Else
        'Find the top-most and left-most cell in the Source
        Dim Topmost As Long, Leftmost As Long
        For Each area In Source.Areas
            If Topmost = 0 Then
                Topmost = area.Row
                Leftmost = area.Column
            Else
                If Topmost > area.Row Then Topmost = area.Row
                If Leftmost > area.Column Then Leftmost = area.Column
            End If
        Next
        'Copy each area to a location offset from the target, such that
        'the topmost cell will be in the row defined by Target and
        'the leftmost cell will be in the column defined by Target
        For Each area In Source.Areas
            area.Copy Destination:=Target.Range(area.Address).Offset(1 - Topmost, 1 - Leftmost)
        Next
    End If
End Sub

基于from，以下代码将复制非连续数据，而不复制不属于联合的单元格

Sub CopyAreas(ByVal Source As Range, _
              ByVal Target As Range, _
              Optional ByVal Inline As Boolean)
    Dim area As Range

    If Inline Then
        For Each area In Source.Areas
            area.Copy Destination:=Target
            Set Target = Target.Offset(area.Rows.Count)
        Next
    Else
        'Find the top-most and left-most cell in the Source
        Dim Topmost As Long, Leftmost As Long
        For Each area In Source.Areas
            If Topmost = 0 Then
                Topmost = area.Row
                Leftmost = area.Column
            Else
                If Topmost > area.Row Then Topmost = area.Row
                If Leftmost > area.Column Then Leftmost = area.Column
            End If
        Next
        'Copy each area to a location offset from the target, such that
        'the topmost cell will be in the row defined by Target and
        'the leftmost cell will be in the column defined by Target
        For Each area In Source.Areas
            area.Copy Destination:=Target.Range(area.Address).Offset(1 - Topmost, 1 - Leftmost)
        Next
    End If
End Sub

---

如错误消息所示，您无法复制包含多个选择的范围-Excel不知道您希望如何将其粘贴到目标，例如，您希望将AH列的信息粘贴到Z列的信息下方，还是将其粘贴到其旁边？如果在它旁边，是希望每列中的第一个单元格对齐，还是希望最后一个单元格对齐？Excel无法确定您想要做什么，所以它内置在Excel中，甚至不需要尝试猜测。如果要复制多个范围，请分别执行每个范围，然后指定其布局方式。（您的第一个报告仅起作用，因为所有范围都是整列，因此只有一种可能的处理方式。）如错误消息所示，您无法复制包含多个选择的范围-Excel不知道您希望如何将其粘贴到目标，例如，您希望将AH列中的信息粘贴到Z列信息的下方，还是将其粘贴到Z列信息的旁边？如果在它旁边，是希望每列中的第一个单元格对齐，还是希望最后一个单元格对齐？Excel无法确定您想要做什么，所以它内置在Excel中，甚至不需要尝试猜测。如果要复制多个范围，请逐个复制，然后指定其布局方式。（您的第一个报告仅起作用，因为所有范围都是整列，因此只有一种可能的处理方法。）导致问题的是非连续、形状不相似的范围。当前代码已经在确保（不是很好，但仍然可以工作）创建的范围位于

wsSheet

工作表上。导致问题的是非连续、形状不相似的范围。当前代码已经在确保（虽然不是很好，但仍然可以工作）创建的范围在

wsSheet

工作表上。