Hi I'm having a problem copying worksheets from one workbook to another in VB. The code I have works fine with brand new workbooks, but after awhile it breaks and gives me this error: "Method 'Copy' of object '_Worksheet' failed. A lot of people suggested saving the workbook and reopening it when you are copying. I tried that and it still didn't work. I also checked if maybe the name is becoming really long. I set the name of the worksheet to the counter before copying it, and I still got the bug. I am really confused, and hope someone may have figured out a solution to this. Also both workbooks only have 3 worksheets in them.
'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
Edit: What I meant with "this workbook breaks after awhile" is that I can run this code on it multiple times (maybe around 30 times). Eventually this error comes up "Method 'Copy' of object '_Worksheet' failed" even if I delete the worksheets in the dest_wb. It points at the Copy line.