Копирование макроса листа перестает делать что-либо, когда книга достигает 50 листов

Question

У меня есть рабочая тетрадь с несколькими титульными листами и несколько листов на обороте, которые содержат несколько графиков. Страницы графиков создаются путем повторного вставления одного листа (" MasterFormat ") снова и снова, каждый раз меняя несколько ключевых значений.

Макрос, который первоначально использовался для быстрого вывода из строя с ошибкой Copy Method of Worksheet Class . В конце концов я нашел, как это исправить, из http://support.microsoft.com/kb/210684.

Проблема в том, что у меня были бесконечные проблемы с моей обновленной версией; главным образом, что он продолжает работать счастливо, но на самом деле ничего не копирует через некоторое время. Отчасти это приятно, потому что обновленная логика включает в себя несколько Set x = y, если x - ничто, тогда s, которые (насколько я знаю) будут работать только с подавленными ошибками, вот что Я сделал. Но, с другой стороны, он останавливает копирование листов после того, как их осталось 50, и не дает никаких объяснений (хотя это может быть неправильное расположение в случае ошибки 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

Он запускается из мета-книги, которая была предложена в статье базы знаний, на которую я ссылался выше. Интересно, что, несмотря на 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

Я взял на себя смелость заменить закрытие / открытие простым Сохранить , так как это должно привести к тому же результату?

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

На основании ответа Лунатика я изменил oBook.Sheets (" MasterFormat "). Скопировать после: = Sheets (j) в oBook.Sheets (" MasterFormat "). Копировать После: = oBook.Sheets (j) , который, похоже, решил проблему.