当工作簿达到 50 个工作表时，复制工作表宏将停止执行任何操作

Question

我有一本工作簿，其中有许多封面，后面还有一堆包含一些图表的工作表。 图形页面是通过一遍又一遍地复制粘贴一张纸（“MasterFormat”）来创建的，每次都会更改一些关键值。

该宏最初用于相当快地解决工作表类复制方法失败错误。 我最终找到了如何修复它，来自 http://support.microsoft.com/kb/210684。

问题是，我的更新版本遇到了无穷无尽的问题； 主要是它继续愉快地运行，但一段时间后实际上并没有复制任何东西。 它令人高兴的部分原因是更新后的逻辑包括一些 Set x = y, if x is Nothing then ，这（据我所知）仅适用于抑制错误，所以这就是我已经搞定了。 但另一方面，它在达到 50 张后停止复印，并且没有给出任何解释（尽管这可能是 on error goto 0 的错误位置）。

有谁知道我应该修复什么才能让它真正复制所有工作表，而不仅仅是感到无聊和停止？

代码如下：

Sub GenerateSheets()
    Application.ScreenUpdating = False

    Dim oBook As Workbook

    On Error Resume Next
    Set oBook = Workbooks("SSReport.xls")

    If oBook Is Nothing Then
        Set oBook = Application.Workbooks.Open("SSReport.xls")
    End If
    On Error GoTo 0

    Dim i, j As Integer
    Dim SheetName As String
    Dim ws As Worksheet
    Const PairingCount = 63

    Dim Pairings(1 To PairingCount, 1 To 2) As String
    For i = 1 To PairingCount
        Pairings(i, 1) = oBook.Sheets("SSPairings").Rows(i + 1).Cells(1)
        Pairings(i, 2) = oBook.Sheets("SSPairings").Rows(i + 1).Cells(2)
    Next i

    For i = 1 To PairingCount

         If i Mod 5 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("SSReport.xls")
         End If

        Application.ScreenUpdating = False
        j = oBook.Worksheets.Count
        SheetName = "P" & Pairings(i, 1) & Pairings(i, 2)
        On Error Resume Next
        Set ws = oBook.Sheets(SheetName)
        If ws Is Nothing Then
            On Error GoTo 0
            oBook.Sheets("MasterFormat").Copy After:=Sheets(j)
            oBook.Sheets("MasterFormat (2)").Name = SheetName
        End If
        oBook.Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
        oBook.Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
        oBook.Sheets(SheetName).Cells(1, 8) = "P"
    Next i

    Application.ScreenUpdating = True
End Sub

它从元工作簿运行，这是我上面链接的知识库文章的建议。 有趣的是，尽管有打开工作簿，但如果主工作簿未打开，它似乎实际上不起作用。

Answer 1

该错误可能是由以下行引起的：

oBook.Sheets("MasterFormat").Copy After:=Sheets(j)

Sheets(j) willrefer to another workbook the code module驻留在其中，这可能不是预期的工作簿。

以下内容对我有用：

Sub GenerateSheets()
Dim oBook As Workbook
Dim i As Long
Dim j As Long
Dim SheetName As String
Dim ws As Worksheet
Const PairingCount = 63
Dim Pairings(1 To PairingCount, 1 To 2) As String

On Error Resume Next
Set oBook = Workbooks("SSReport.xls")
On Error GoTo 0
If oBook Is Nothing Then
    Set oBook = Application.Workbooks.Open("SSReport.xls")
End If

With oBook
    For i = 1 To PairingCount
        Pairings(i, 1) = .Sheets("SSPairings").Rows(i + 1).Cells(1)
        Pairings(i, 2) = .Sheets("SSPairings").Rows(i + 1).Cells(2)
    Next i

    For i = 1 To PairingCount
        If i Mod 5 = 0 Then
            '//Save in case of corruption/error?'
            .Save
        End If

        j = .Worksheets.Count

        SheetName = "P" & Pairings(i, 1) & Pairings(i, 2)

        On Error Resume Next
        Set ws = .Sheets(SheetName)
        On Error GoTo 0
        If ws Is Nothing Then
            .Sheets("MasterFormat").Copy After:=.Sheets(j)
            .Sheets("MasterFormat (2)").Name = SheetName
        End If

        .Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
        .Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
        .Sheets(SheetName).Cells(1, 8) = "P"
    Next i
End With
End Sub

我冒昧地用简单的 Save 替换了关闭/重新打开，因为这应该达到相同的结果？

Answer 2

尝试更改

        If ws Is Nothing Then
            On Error GoTo 0
            oBook.Sheets("MasterFormat").Copy After:=Sheets(j)
            oBook.Sheets("MasterFormat (2)").Name = SheetName
        End If
        oBook.Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
        oBook.Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
        oBook.Sheets(SheetName).Cells(1, 8) = "P"

为

     If ws Is Nothing Then
        On Error GoTo 0
        oBook.Sheets("MasterFormat").Copy After:=Sheets(j)
        oBook.Sheets("MasterFormat (2)").Name = SheetName
    else
       oBook.Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
       oBook.Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
       oBook.Sheets(SheetName).Cells(1, 8) = "P"
    End If

“我猜如果 ws 什么都没有，那么它会卡在接下来的 3 行中”。

Answer 3

根据 Lunatik 的回答，我将 oBook.Sheets("MasterFormat").Copy After:=Sheets(j) 更改为 oBook.Sheets("MasterFormat").Copy After:=oBook。 Sheets(j)，这似乎解决了问题。