您好我在VB中将工作表从一个工作簿复制到另一个工作簿时遇到问题.我使用全新的工作簿编写的代码很好,但过了一段时间它就会中断并给我这个错误：“对象’_Worksheet’的方法’复制
'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中的工作表.它指向复制行.
我有一个类似的问题从’模板’文件复制工作表.我认为这是一个内存问题,在经过一定数量的复制和粘贴(取决于您的系统)后启动.根据您的工作表包含的内容,有一些解决方法.我不需要遍历许多工作簿,但我发现以下功能可以有效地做同样的事情而没有任何问题.
但是,需要注意的一点是,每次将工作表从一个工作簿复制到另一个工作簿时,您可能无法创建两个新的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