VBA宏在工作簿名稱IF指令上絆倒

Question

我拼湊在一起的所有打開的工作簿中的指定工作表中的內容的代碼似乎在我的計算機上運行良好，但在客戶端上運行良好。

這裏怎麼回事？我相信我們正在運行相同版本的Excel，並使用相同的工作簿進行測試。

它卡住第22行：

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

對不起，我沒有錯誤信息！

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 

它在執行整理操作時也無法找到正確的最後一行，所以我需要調整它。但那不是重點。

Answer 1

在你的代碼中提到的F​​or循環For Each wkb In Workbooks用於拉說，從每一個打開的工作簿的工作表名稱和複製到宏工作簿。這意味着它會在所有打開的工作簿中查找工作表Query1，並且當任何工作簿沒有名爲Query1的工作表時，會拋出Subscript out of range錯誤。

您可以通過兩種方式解決此錯誤：
確保所有的工作簿具有片Query1（不認爲這總會發生）在你的代碼

處理
2.使用錯誤

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並不以任何方式「修復」錯誤。它只是指示VBA繼續，就好像沒有錯誤發生一樣。有關詳細信息，請參閱此link。