excel - 运行时错误 91 - 对象变量或未设置 block 变量

Question

我想将来自工作簿的多张工作表的数据合并到一张我称之为“合并”的工作表中。即使出现“运行时错误'91:对象变量或未设置 block 变量”错误，代码仍然被正确评估。但是，要粘贴的最后一个工作表中的数据仍被选中/突出显示。

当我调试错误时，它就在线:Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy
我怎样才能解决这个问题？谢谢

Sub Combine()
'Combines columns of all sheets of a workbook into one sheet "combined"

Dim NR As Long 'starting row to paste data to combined sheet
Dim BR As Long 'length of rows of the copied data in each sheet
Dim wsNum As Long 'number of sheets in workbook
Dim wsOUT As Worksheet 'new workbook created with combined data
Dim titles() As Variant
Dim i As Long

Application.ScreenUpdating = False
On Error Resume Next
Set wsOUT = Sheets("Combine")
On Error GoTo 0

If wsOUT Is Nothing Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
    Set wsOUT = Sheets("Combine")
End If    
wsOUT.Cells.Clear

titles() = Array("Fe Wave", "Fe Amp", "Cr Wave", "Cr Amp", "Worksheet", "", "Bin Center", "FeW Count", "FeA Count", "CrW Count", "CrA Count", "", "FeW tot", "FeA tot", "CrW tot", "CrA tot", "", "FeW%", "FeA%", "CrW%", "CrA%", "", "Int", "FeW Bino", "FeA Bino", "CrW Bino", "CrA Bino", "", "FeW Bino", "FeA Bino", "CrW Bino", "CrA Bino", "", "FeW <X>", "FeA <X>", "CrW <X>", "CrA <X>", "", "FeW std", "FeA std", "CrW std", "CrA std")

With wsOUT        
    For i = LBound(titles) To UBound(titles)
        .Cells(1, 1 + i).Value = titles(i)
    Next i

    .Rows(1).Font.Bold = True
End With

wsOUT.Activate
Range("A2").Select
ActiveWindow.FreezePanes = True
NR = 2

For wsNum = 1 To Sheets.Count
    If UCase(Sheets(wsNum).Name) <> "COMBINE" Then
        Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy
        wsOUT.Range("A" & NR).PasteSpecial xlPasteValues
        With wsOUT
            BR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
        wsOUT.Range("E" & NR & ":E" & BR).Value = Sheets(wsNum).Name
        NR = BR + 1
    End If
Next wsNum

wsOUT.Columns.AutoFit
Range("A1").Select
ActiveWindow.ScrollRow = 1
Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Answer 1

您需要先查看 Sheets(wsNum).UsedRange 之间是否存在重叠范围和 Sheets(wsNum).Range("BF:BI") .

我添加了另一个 Range 对象(不是必需的，只是为了我的调试更容易)，Dim IntRng As Range ，我将其设置为 Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")) .

最后，只需检查 If Not IntRng Is Nothing Then .

尝试更换您的 For使用以下代码循环:

Dim IntRng As Range

For wsNum = 1 To Sheets.Count
    If UCase(Sheets(wsNum).Name) <> "COMBINE" Then
        Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI"))

        If Not IntRng Is Nothing Then '<-- check is IntRng successfully Set
            IntRng.Offset(1).Copy
            wsOUT.Range("A" & NR).PasteSpecial xlPasteValues

            ' the rest of your coding

        Else '<-- unable to find Intersect between the two ranges
            ' do something....
        End If

        With wsOUT
            BR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
        wsOUT.Range("E" & NR & ":E" & BR).Value = Sheets(wsNum).Name
        NR = BR + 1
    End If
Next wsNum