運行時錯誤91 - 對象變量或未設置塊變量

Question

我想將來自多張工作簿的數據合併到一張稱爲「合併」的工作表中。即使「運行時錯誤'91：對象變量或'塊變量未設置'出現錯誤，代碼仍然正確計算。但是，要粘貼的上一張工作表中的數據仍然是選中/突出顯示的。

當我調試的錯誤，這是上線： 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