在VBA復制錯誤中復制工作表

Question

您好我在VB中將工作表從一個工作簿復制到另一個工作簿時遇到問題。 我使用全新的工作簿編寫的代碼很好，但過了一段時間它就會中斷並給我這個錯誤：“對象'_Worksheet'的方法'復制'失敗了。很多人建議保存工作簿並在復制時重新打開它。我試過了，它仍然無法工作。我還檢查了名稱是否變得非常長。我在復制之前將工作表的名稱設置到計數器，我仍然得到了錯誤。我真的很困惑，並且希望有人可能已經找到了解決方案。這兩個工作簿中只有3個工作表。

'Copies all the worksheets from one workbook to another workbook
'source_name is the Workbook's FullName
'dest_name is the Workbook's FullName
Function copyWorkbookToWorkbook(source_name As String, dest_name As String) As Boolean
    Dim dest_wb As Workbook
    Dim source_wb As Workbook
    Dim dest_app As New Excel.Application
    Dim source_app As New Excel.Application
    Dim source_ws As Worksheets
    Dim counter As Integer
    Dim num_ws As Integer
    Dim new_source As Boolean
    Dim new_dest As Boolean
    Dim ws As Worksheet
    Dim regex As String

    Application.ScreenUpdating = False

    If source_name = "" Or dest_name = "" Then
        MsgBox "Source and Target must both be selected!", vbCritical
        copyWorkbookToWorkbook = False
    ElseIf GetAttr(dest_name) = vbReadOnly Then
        MsgBox "The target file is readonly and cannot be modified", vbCritical
        copyWorkbookToWorkbook = False
    Else
        regex = "[^\\]*\.[^\\]*$"   'Gets only the filename
        copyWorkbookToWorkbook = True

        If (isWorkbookOpen(source_name)) Then
            Set source_wb = Workbooks(regExp(source_name, regex, False, True)(0).Value)
        Else
            Set source_wb = source_app.Workbooks.Open(source_name)
            new_source = True
        End If

        If (isWorkbookOpen(dest_name)) Then
            Set dest_wb = Workbooks(regExp(dest_name, regex, False, True)(0).Value)
        Else
            Set dest_wb = dest_app.Workbooks.Open(dest_name)
            new_dest = True
        End If

        'Clean the workbooks before copying the data
        'Call cleanWorkbook(source_wb)
        'Call cleanWorkbook(dest_wb)

        'Copy each worksheet from source to target

        counter = 0
        source_wb.Activate
        For Each ws In source_wb.Worksheets
            MsgBox dest_wb.Worksheets.Count
            ws.Copy After:=dest_wb.Worksheets(dest_wb.Worksheets.Count)
            counter = counter + 1
        Next ws

        'Save and close any newly opened files
        If (new_dest) Then
            dest_wb.Application.DisplayAlerts = False
            dest_wb.SaveAs Filename:=dest_name, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
            dest_wb.Application.CutCopyMode = False
            dest_wb.Close
        End If
        If (new_source) Then
            source_wb.Application.DisplayAlerts = False
            source_wb.SaveAs Filename:=source_name, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
            source_wb.Close
        End If

        MsgBox counter & " worksheets have been cleaned and copied.", vbInformation + vbOKOnly

    End If

    'Cleanup
    Set dest_wb = Nothing
    Set source_wb = Nothing
    Set dest_app = Nothing
    Set source_app = Nothing
    Set source_ws = Nothing
    Set ws = Nothing
End Function

Function regExp(str As String, pattern As String, ignore_case As Boolean, glo As Boolean) As MatchCollection
    Dim regex As New VBScript_RegExp_55.regExp
    Dim matches As MatchCollection

    regex.pattern = pattern
    regex.IgnoreCase = ignore_case
    regex.Global = glo

    Set regExp = regex.Execute(str)
End Function

編輯：我的意思是“此工作簿在一段時間后中斷”是我可以多次運行此代碼（可能大約30次）。 最終出現此錯誤“對象'_Worksheet'的方法'復制'失敗”即使我刪除了dest_wb中的工作表。 它指向復制行。

Answer 1

我有一個類似的問題從'模板'文件復制工作表。 我認為這是一個內存問題，在經過一定數量的復制和粘貼（取決於您的系統）后啟動。

根據您的工作表包含的內容，有一些解決方法。 我不需要遍歷許多工作簿，但我發現以下功能可以有效地做同樣的事情而沒有任何問題。

但是，需要注意的一點是，每次將工作表從一個工作簿復制到另一個工作簿時，您可能無法創建兩個新的Excel實例。 為什么不能使用Excel實例只使用至少一個Excel實例。

Sub CopyWorksheet(wsSource As Worksheet, sName As String, wsLocation As Worksheet, sLocation As String)
    'Instead of straight copying we just add a temp worksheet and copy the cells.
    Dim wsTemp As Worksheet

    'The sLocation could be a boolean for before/after. whatever.
    If sLocation = "After" Then
        Set wsTemp = wsLocation.Parent.Worksheets.Add(, wsLocation)
    ElseIf sLocation = "Before" Then
        Set wsTemp = wsLocation.Parent.Worksheets.Add(wsLocation)
    End If

    'After the new worksheet is created
    With wsTemp
        .Name = sName                           'Name it
        .Activate                               'Bring it to foreground for pasting
        wsSource.Cells.Copy                     'Copy all the cells in the original
        .Paste                                  'Paste all the cells
        .Cells(1, 1).Select                     'Select the first cell so the whole sheet isn't selected
    End With
    Application.CutCopyMode = False
End Sub

Answer 2

是的，我在使用的某些代碼中遇到了完全相同的問題，盡管從來沒有足夠的壓力讓我去做（顯然）我需要解決的問題。

此知識庫文章中描述了該問題。 文章建議：

若要解決此問題，請在復制過程中定期保存並關閉工作簿

我注意到你說你在復制時“正在保存並重新打開工作簿”，但我認為你在運行代碼之前就已經這樣做了，因為我沒有看到它在循環過程中有任何跡象。 在循環內部執行此操作的一種方法是：

通過擁有一個實現錯誤處理

On Error Goto

在程序的早期; 然后

放一個

Exit Function
ErrorHandler:

擋在底部。 在錯誤處理程序本身內部，您需要檢查Err.Number是否為1004.如果是，請關閉源工作簿和目標工作簿，然后重新打開它們，並在發生錯誤的行繼續。 最好跟蹤對錯誤處理程序的調用次數，並在一定數量后放棄以確保不會以無限循環結束。

這基本上是我解決我的問題的想法，但我從來沒有時間/迫切需要實現它。 在發布之前我已經測試過了，但文件在辦公室，我目前無法訪問它們。

如果你決定沿着這條路走下去，我會很高興看到你如何去。

另一個選項是知識庫文章中建議的選項，即在n次迭代后關閉並重新打開本書。 問題在於它建議100次迭代，而礦井在32或33之后失敗。（這似乎取決於工作表的大小，除其他外。）還有一些情況，當我的失敗后10（具有完全相同的工作表）並且解決這個問題的唯一方法是關閉並重新打開Excel。 （顯然，基於VBA的代碼的選項並不多。）