Copiar planilha macro pára fazendo nada quando o livro atinge 50 planilhas

Question

Eu tenho um livro que tem uma série de folhas de rosto e, em seguida, um monte de folhas na parte de trás que são contêm alguns gráficos. As páginas de gráficos são criados por-colar uma cópia de folha ( "MasterFormat") repetidas vezes, alterando uma chave poucos valores de cada vez.

A macro originalmente usado para entrar em pane, muito rapidamente com um erro Copy Method of Worksheet Class failed. Eu finalmente encontrei como corrigi-lo, a partir http://support.microsoft.com/kb/210684.

O problema é, eu tive problemas intermináveis ??com a minha versão atualizada; principalmente que continua a correr alegremente, mas na verdade não copiar qualquer coisa depois de um tempo. Parte da razão pela qual ele está feliz é que a lógica atualizada inclui algumas Set x = y, if x is nothing thens, que (tanto quanto eu sei) só trabalho com erros reprimidos, então é isso que eu fiz. Mas, por outro lado, ele pára de copiar folhas após existem 50 folhas, e não dá nenhuma explicação (embora este pode ser o mislocation do on error goto 0).

Alguém sabe o que eu deveria estar se preparando para torná-lo realmente copiar todas as folhas, não apenas se cansar e parar?

O código é a seguinte:

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

É executado a partir de uma pasta de trabalho meta, que era a sugestão do artigo KB I link acima. Curiosamente, apesar do Open workbook, ele não parece realmente trabalho se o livro principal não está aberta.

Answer 1

O erro é provavelmente causado por esta linha:

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

O Sheets(j) irá se referir a qualquer pasta de trabalho que reside o módulo de código em, que pode não ser o livro destina-se.

Os seguintes trabalhos para mim:

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

Tomei a liberdade de substituir o a fechar / reabrir com um Save simples como isto deve conseguir o mesmo resultado?

Answer 2

Tente alterar

        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"

para

     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

Eu acho que se ws é nada, então ele ficou preso nos próximos 3 linhas.

Answer 3

Com base na resposta de Lunatik, eu mudei oBook.Sheets("MasterFormat").Copy After:=Sheets(j) para oBook.Sheets("MasterFormat").Copy After:=oBook.Sheets(j), que parecia resolver o problema.