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

是的，我在使用的某些代码中遇到了完全相同的问题，尽管从来没有足够的压力让我去做（显然）我需要解决的问题。

this知识库文章中描述了该问题。文章建议：

要解决此问题，请定期保存并关闭工作簿复制过程正在进行中

我注意到你说你在复制时“正在保存并重新打开工作簿”，但我认为你在运行代码之前就已经这样做了，因为我没有看到它在循环过程中有任何迹象。在循环内部执行此操作的一种方法是：

通过

实现错误处理

On Error Goto

在程序的早期行;然后

提出

Exit Function
ErrorHandler:

在底部阻止。在错误处理程序本身内部，您需要检查Err.Number是否为1004.如果是，请关闭源工作簿和目标工作簿，然后重新打开它们，并在发生错误的行继续。最好跟踪对错误处理程序的调用次数，并在一定数量后放弃，以确保不会以无限循环结束。

这基本上是我解决问题的想法，但我从来没有时间/迫切需要实施它。在发布之前我已经测试过了，但文件在办公室，我目前无法访问它们。

如果你决定沿着这条道路走下去，我会很高兴看到你走了。

另一个选项是知识库文章中建议的选项，即在n次迭代后关闭并重新打开本书。问题在于它建议100次迭代，而矿井在32或33之后失败。（这似乎取决于工作表的大小，除其他外。）还有一些情况，当我的失败后10（具有完全相同的工作表）并且解决这个问题的唯一方法是关闭并重新打开Excel。（显然，基于VBA的代码的选项并不多。）

在VBA复制错误中复制工作表

2 个答案: