VBA-Makro stolpert auf Arbeitsmappename IF-Befehl

Question

Dieser Code, den ich für das Zusammenstellen von Inhalt aus einem benannten Arbeitsblatt aus allen geöffneten Arbeitsmappen zusammengestellt habe, scheint auf meinem Computer, aber nicht auf den Clients einwandfrei zu funktionieren.

Was läuft hier falsch? Ich glaube, wir haben die gleiche Version von Excel und verwenden identische Arbeitsmappen zum Testen.

 wkb.Worksheets(sWksName).Copy _ 
      Before:=ThisWorkbook.Sheets(1) 

Leider habe ich nicht die Fehlermeldung:

wird es auf der Leitung 22 fest!

Sub CopyandCollateQuery1() 

With Application      ' Scrubs settings that slow process 
    .ScreenUpdating = False 
    .EnableEvents = False 
    .Calculation = xlCalculationManual 
    .DisplayAlerts = False 
End With 


    Dim wkb As Workbook     ' Dim Variables 
    Dim sWksName As String 
    Dim Title1 As Range 
    Dim Title1end As Range 
    Dim NewRng As Range 
    Dim check As String 

    sWksName = "Query1"     ' Sets Worksheet to be collated 

    For Each wkb In Workbooks   ' Pulls said worksheet title from each open workbook and copies into macro workbook 
     If wkb.Name <> ThisWorkbook.Name Then 
      wkb.Worksheets(sWksName).Copy _ 
       Before:=ThisWorkbook.Sheets(1) 
     End If 
    Next 
    Set wkb = Nothing 

For Each ws In ThisWorkbook.Worksheets 
    With ws 
      If .Name <> "Collated" Then 
       rowscount = .Cells(ws.Rows.Count, 2).End(xlUp).Row 
       .Range("B3" & ":" & "B" & rowscount).Copy 
       Worksheets("Collated").Activate 
       Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select 
       ActiveSheet.Paste 
       Application.CutCopyMode = False 
     End If 
    End With 
Next ws 

    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo 

    If ActiveSheet.Cells(1, 1).Value = "" Then 
    Rows(1).Delete 
    ActiveSheet.Cells(1, 2).Value = "Total Combined Count" 
    End If 
    ActiveSheet.Cells(1, 1).Activate 

For Each ws In ThisWorkbook.Worksheets 
    With ws 
      Set lol = ws.Name 
      If .Name <> "Collated" Then 
       i = 4 
       Do While i < rowscount + 1 
       check = .Range("B" & i).Value 
       checknum = .Range("B" & i).Offset(0, -1).Value 

       Sheets("Collated").Activate 
       Worksheets("Collated").Range("A:A").Find(check, LookAt:=xlWhole).Activate 

       ActiveCell.Offset(0, 1).Select 
       ActiveCell.Value = ActiveCell.Value + checknum 
       checknum = 0 

       i = i + 1 
       Loop 

      End If 
    End With 
Next ws 

With Application      ' undoes initial processes scrub 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .Calculation = xlCalculationAutomatic 
    .DisplayAlerts = True 
End With 

End Sub 

Es ist auch Probleme, die richtige letzte Zeile zu finden, wenn die Sortier Aktion ausgeführt wird, so will ich, dass anpassen müssen. Aber das ist nebensächlich.

Answer 1

Wie im Code erwähnte For Each wkb In Workbooks die For-Schleife Pull verwendet wird, die Arbeitsblatt-Titel von jedem geöffneten Arbeitsmappe und und in Makro-Arbeitsmappe kopiert. Das bedeutet, dass in allen geöffneten Arbeitsmappen nach dem Blatt Query1 gesucht wird und wenn keine Arbeitsmappe ein Blatt mit dem Namen Query1 hat, wird Subscript out of range Fehler ausgegeben.

Sie diesen Fehler auf zwei Arten angehen können:
1. Stellen Sie sicher, alle Ihre Arbeitsmappen hat Blatt Query1 in Ihrem Code (nicht denken, wird es immer geben)
2. Verwenden Fehlerbehandlung

For Each wkb In Workbooks 
    If wkb.Name <> ThisWorkbook.Name Then 
     On Error Resume Next  '<--- add this line in your code 
     wkb.Worksheets(sWksName).Copy _ 
      Before:=ThisWorkbook.Sheets(1) 
    End If 
Next 

on error Resume Next nimmt die Ausführung einen Fehler auf der nächsten Zeile Code geworfen zu ignorieren. Bitte beachten Sie, dass On Error Resume Next den Fehler in keiner Weise "behebt". Es weist VBA einfach so an, als ob kein Fehler aufgetreten wäre. Für Details siehe link.