통합 문서가 50 워크 시트를 때릴 때 워크 시트 복사 매크로가 무엇이든 중지됩니다.

Question

나는 많은 커버 시트가있는 통합 문서와 뒷면에 몇 개의 그래프가 포함 된 많은 시트가 있습니다. 그래프 페이지는 하나의 시트 ( "mas

원래 매크로는 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) 코드 모듈이있는 통합 문서를 참조하여 의도 된 통합 문서가 아닐 수도 있습니다.

다음은 저를 위해 작동합니다.

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

나는 The The Close/Reopen을 간단한 것으로 대체 할 자유를 얻었습니다. Save 이것이 동일한 결과를 달성해야합니까?

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), 문제를 해결하는 것 같았습니다.