當工作簿命中50個工作表時，複製工作表宏將停止執行任何操作

Question

我有一個工作簿，其中包含一些封面，然後是包含幾張圖的背面一堆工作表。圖形頁面通過一遍又一遍地複製粘貼一張表格（「MasterFormat」）來創建，每次更改幾個關鍵值。

該宏最初用於相當快地生成一個Copy Method of Worksheet Class failed錯誤。我終於找到了如何解決它，從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 

它從元的工作簿，這是KB文章我掛上面的建議運行。有趣的是，儘管Open workbook，如果主工作簿沒有打開，它似乎並不工作。

Answer 1

的錯誤可能是由這種行：

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

的Sheets(j)將指取其工作簿中的代碼模塊駐留在，這可能不是所預期的工作簿。

對我來說，以下的工作：用一個簡單的Save因爲這

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 

我把更換的緊密的自由/重啓應達到同樣的效果？

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)，這似乎解決了問題。