Laufzeitfehler 91 - Objektvariable oder mit Blockvariable nicht gesetzt

Question

Ich möchte meine Daten aus mehreren Blättern einer Arbeitsmappe in einem Blatt kombinieren, das ich 'kombinieren' nenne. Obwohl der Fehler "Laufzeitfehler '91: Objektvariable oder Mit Blockvariable nicht gesetzt" aufgetreten ist, wurde der Code trotzdem korrekt ausgewertet. Die Daten aus dem letzten einzufügenden Arbeitsblatt wurden jedoch weiterhin ausgewählt/hervorgehoben.

Wenn ich die Fehler debuggen, ist es auf der Linie: Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy

Wie kann ich dieses Problem beheben? Dank

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

Sie müssen zuerst sehen, ob es eine Überlappung Bereich zwischen Sheets(wsNum).UsedRange und Sheets(wsNum).Range("BF:BI") ist.

Ich habe ein anderes Range-Objekt hinzugefügt (nicht notwendig, nur einfacher für mein Debug), Dim IntRng As Range, und ich setze es auf Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).

Und zuletzt, überprüfen Sie einfach If Not IntRng Is Nothing Then.

Versuchen Sie, Ihre For Schleife mit dem folgenden Code ersetzen: Sie

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