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

正如您的代码中所提到的，For循环For Each wkb In Workbooks用于 从每个打开的工作簿中拉出所述工作表标题，然后复制到宏工作簿 。这意味着它会在所有打开的工作簿中查找工作表Query1，并且当任何工作簿没有名为Query1的工作表时，它会抛出Subscript out of range错误。

您可以通过两种方式解决此错误：
1。确保所有工作簿都有工作表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 恢复执行，忽略下一行代码抛出的任何错误。请注意，On Error Resume Next不以任何方式“修复”错误。它只是指示VBA继续，就像没有发生错误一样。有关详细信息，请参阅此link。

VBA宏在工作簿名称IF命令上发生故障

1 个答案: