Have Geek Brain

Macro worksheet macro stops doing anything when the workbook hits 50 sheets

I have a book that has a few title pages and then a few sheets in the back that contain a few graphs. Graphic pages are created by copying to one sheet ("MasterFormat") over and over, changing several key values ​​each time.

A macro originally used for a quick exit with an error Copy Method of Worksheet Class failed

. I eventually found how to fix this from http://support.microsoft.com/kb/210684 .

The problem is, I had endless problems with my updated version; basically that it continues to work happily, but doesn't actually copy anything after a while. Part of the good news is that the updated logic includes a few Set x = y, if x is nothing then

s, which (as far as I know) will only work with suppressed bugs, so I did. But, on the other hand, he stops copying sheets after 50 sheets and does not provide an explanation (although this may be the wrong arrangement on error goto 0

).

Does anyone know what I should be fixing in order to actually copy all the sheets and not just get bored and stop?

The code looks like this:

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

It starts from a meta book that was suggested by the KB article linked to above. Interestingly, despite Open workbook

, it doesn't work if the main book is not open.

0


source to share


3 answers


The error is probably caused by this line:

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

Sheets(j)

will link to whatever workbook that contains a code module that cannot be the intended workbook.



The following works for me:

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

I took the liberty of replacing close / reopen with a simple one Save

, so how was that supposed to achieve the same result?

+1


source


Try to change

        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"

at



     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

I guess if ws is nothing, it is stuck on the next 3 lines.

0


source


Based on Lunatik's answer, I changed oBook.Sheets("MasterFormat").Copy After:=Sheets(j)

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

, which seemed to fix the problem.

0


source






More articles:


All Articles