コピーワークシートマクロは、ワークブックが50個のワークシートに当たったときに何もしないでください。

Question

数枚の表紙があり、後ろに数枚のグラフが含まれているブックがあります。グラフページは、1枚のシート（「MasterFormat」）を何度も繰り返しコピーして貼り付け、毎回いくつかのキー値を変更することによって作成されます。

Copy Method of Worksheet Class failedエラーでかなり急速に処理されたマクロです。私は最終的にそれを修正する方法を見つけた、http://support.microsoft.com/kb/210684から。

問題は、私は更新版に無限の問題があったことです。主に幸せに走り続けていますが、しばらく後には何もコピーしません。なぜ私が満足しているのは、更新されたロジックにはいくつかのエラーが含まれているということです（これまでのところ知っている限り）。しかし、一方では、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)が意図ブックではない可能性がある、コードモジュールが常駐ワークブックいずれかを指します。私にとって

次の作品は：

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

は、私はWSが何もないならば、それは次の3行で立ち往生推測

 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 

に

 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" 

を変更してみてください。

Answer 3

ルナティクの答えに基づいて、oBook.Sheets("MasterFormat").Copy After:=Sheets(j)をoBook.Sheets("MasterFormat").Copy After:=oBook.Sheets(j)に変更しました。これは問題を解決したようです。