Copying worksheet programmatically causes run-time error 1004 in Excel

G

gquest

Board Regular
Joined
Feb 20, 2007
Messages
167
Hey Everyone,

I have a procedure that creates a copies of a worksheet (template), renames and inserts them at a particular point in the workbook and then copies & pastes corresponding data from a database worksheet into this respective worksheets. The macro does this one at a time.

It works fine for the first 30-35 copies I use it, but if it goes above that number the macro fails and I get the following error:

Run-time error '1004'
Copy method of Worksheet class failed

After researching the issue, it appears to be a MS VBA bug where If you copy a sheet multiple times without closing the workbook periodically, you will get that error (source: hyperlink below).

Copying worksheet programmatically causes run-time error 1004 in Excel

I read MS' statement that, to get around this problem and it seems like there are only two options: (1) edit the code so that the workbook closes/reopens periodically while copying, or (2) make a template workbook instead of copying the sheet.

The first option would slow my macro down considerably, since the file takes a while to save and well I'm not really sure I understand the second option.

Is there an easier way to fix this issue or a better workaround then the two provided by Microsoft?

Any advice or help would be greatly appreciated!

Thank you in advance,

George
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
I think you can get away with just saving the book periodically, not necessarily closing/reopening...
 
Upvote 0
Here's my code if anyone is curious about my copy method. I'm also open to suggestion on cleaning up my coding.

Code: 
Sub RunReport()
Dim wsheet As Worksheet
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="password"
For Each wsheet In Sheets
wsheet.Unprotect
Next wsheet

Sheets("Template").Visible = True

Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim A As Worksheet
Dim b As Worksheet
Dim icount As Long

Set A = Sheets("Input")
Set b = Sheets("Translation Table")
icount = A.Range("a4").Value

For Each Sheet In Sheets
Select Case Sheet.Name
Case "Input", "Template", "Translation Table", "Emails", "Sheet1"
'Do Nothing
Case Else
Sheet.Delete
End Select
Next Sheet

If icount > 1 Then

A.Range("a6").Copy
A.Range("a6").Resize(icount, 1).PasteSpecial xlPasteFormulas
A.Range("a6").Resize(icount, 1).Calculate

End If

A.Range("a6").Resize(icount, 29).Sort key1:=A.Range("a6")
A.Range("a5").Resize(icount + 1, 1).Copy
b.Range("i2").PasteSpecial xlPasteValues
b.Range("i2").Resize(icount + 1, 1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=b.Range("g2"), Unique:=True
b.Range("i2").Resize(icount + 1, 1).ClearContents
b.Range("h1").Calculate
b.Range("h3").Copy
b.Range("h3").Resize(b.Range("h1"), 1).PasteSpecial xlPasteFormulas
b.Range("h3").Resize(b.Range("h1"), 1).Calculate

Dim Lead As Range

For Each Lead In b.Range("g3").Resize(b.Range("h1").Value, 1)

Sheets("Template").Copy After:=Sheets(Sheets.Count)
Sheets("Template (2)").Name = Lead.Value

Sheets("Input").Select
Range("A:A").Find(What:=Lead.Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Resize(Lead.Offset(0, 1).Value, 28).Copy
Sheets(Lead.Value).Select
Sheets(Lead.Value).Range("A2").PasteSpecial xlPasteValues
Sheets(Lead.Value).Range("A2").PasteSpecial xlPasteFormats
Sheets(Lead.Value).Rows("1:1").AutoFilter
Next Lead

b.Range("h4").Resize(b.Range("h1") - 1, 1).ClearContents
b.Range("g3").Resize(b.Range("h1"), 1).ClearContents

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Sheets("Template").Visible = False
ActiveWorkbook.Protect Password:="password", Structure:=True, Windows:=False
Application.ScreenUpdating = True

End Sub
 
Upvote 0
jonmo1 said:
I think you can get away with just saving the book periodically, not necessarily closing/reopening...
Click to expand...

jonmo1, I added code to save the workbook periodically, but still got the error message.

Also, I can't seem to get the save, close and re-open code that Microsoft provides to work, It saves and close the file, but doesn't seem to want to re-open or maybe it's working very slow.

I think the template option might be my best bet, but there's no code provided for it and I'm not really sure how to incorporate in a dynamic way. By dynamic, I mean move a copy of the template tab to a new workbook, save the workbook to the same location or desktop, use in the procedure and delete afterwards.

Work Around Option II From Microsoft:
To work around this problem, insert a new worksheet from a template instead of copying an existing worksheet. To do this, follow these steps, as appropriate for the version of Excel that you are running.

Microsoft Office Excel 2003 and earlier versions of Excel
  1. Create a new workbook, and then delete all of the worksheets except for one.
  2. Format the workbook, and then add any text, data, and charts that you must have in the template by default.
  3. Click File, and then click Save As.
  4. In the File name box, type the name that you want for the Excel template.
  5. In the Save as type list, click Template (*.xlt), and then click Save.
  6. To insert the template programmatically, use the following code:
    Sheets.Add Type:=path\filename
In this code, path\filename is a string that contains the full path and file name for your sheet template.
Click to expand...



Any other ideas?
 
Last edited:
Upvote 0
If your code saves, closes, and reopens the worbook, it can't be running in that workbook.
 
Upvote 0
shg4421 said:
If your code saves, closes, and reopens the worbook, it can't be running in that workbook.
Click to expand...


shg4421, so I need to have it in another workbook, add-in or maybe a workbook in the XLSTART folder? Sorry, not really sure how to approach the issue now that you brought that up.

Isn't the code Microsoft provided below saving, closing and reopening while running in the same workbook (see below)?

Microsoft's Example Workaround Code:
Code: 
'To resolve this problem, save and close the workbook periodically while the copy process is occurring, as in the following sample code:

Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim iCounter As Integer
    
    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iTemp
    
    ' Add a defined name to the workbook
    ' that RefersTo a range:
    oBook.Names.Add Name:="tempRange", _
        RefersTo:="=Sheet1!$A$1"
            
    ' Save the workbook:
    oBook.SaveAs "c:\test2.xls"
    
    ' Copy the sheet in a loop. Eventually,
    ' you get error 1004: Copy Method of
    ' Worksheet class failed.
    For iCounter = 1 To 275
        oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
        'Uncomment this code for the workaround:
        'Save, close, and reopen after every 100 iterations:
        If iCounter Mod 100 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("c:\test2.xls")
        End If
    Next
End Sub

I tried taking this code and applying it to mine, but as previously mentioned it's not working. Below is my macro with the Save, Close, Re-Open Procedure added. I think the issue might have something to do with the iCounter piece. Do I need to set that?

My Code + Microsoft's Example Workaround Code:
Code: 
Sub RunReport()
    Dim wsheet As Worksheet
    Dim pbook As Workbook
    Dim A As Worksheet
    Dim b As Worksheet
    Dim Lead As Range
    Dim icount As Long
    Dim iCounter As Integer
        Set A = Sheets("Input")
        Set b = Sheets("Translation Table")
        icount = A.Range("a4").Value
        Set pbook = ActiveWorkbook

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.CalculateBeforeSave = False
    Application.DisplayAlerts = False
    ActiveWorkbook.Unprotect Password:="password"

    For Each wsheet In Sheets
        wsheet.Unprotect
    Next wsheet

    Sheets("Template").Visible = True

    For Each Sheet In Sheets
        Select Case Sheet.Name
        Case "Input", "Template", "Translation Table", "Emails", "Sheet1"
            'Do Nothing
        Case Else
            Sheet.Delete
        End Select
    Next Sheet

    If icount > 1 Then
        A.Range("a6").Copy
        A.Range("a6").Resize(icount, 1).PasteSpecial xlPasteFormulas
        A.Range("a6").Resize(icount, 1).Calculate
    End If

    A.Range("a6").Resize(icount, 29).Sort key1:=A.Range("a6")
    A.Range("a5").Resize(icount + 1, 1).Copy
    b.Range("i2").PasteSpecial xlPasteValues
    b.Range("i2").Resize(icount + 1, 1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=b.Range("g2"), Unique:=True
    b.Range("i2").Resize(icount + 1, 1).ClearContents
    b.Range("h1").Calculate
    b.Range("h3").Copy
    b.Range("h3").Resize(b.Range("h1"), 1).PasteSpecial xlPasteFormulas
    b.Range("h3").Resize(b.Range("h1"), 1).Calculate

    For Each Lead In b.Range("g3").Resize(b.Range("h1").Value, 1)
        If iCounter Mod 100 = 0 Then
            pbook.Close SaveChanges:=True
            Set pbook = Nothing
            Set pbook = Application.Workbooks.Open("C:\Documents and Settings\gsmith\My Documents\2011\Template.xls")
            
            pbook.Sheets("Template").Copy After:=pbook.Sheets(Sheets.Count)
            pbook.Sheets("Template (2)").Name = Lead.Value
                Sheets("Input").Select
                Range("A:A").Find(What:=Lead.Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Resize(Lead.Offset(0, 1).Value, 28).Copy
                Sheets(Lead.Value).Select
                Sheets(Lead.Value).Range("A2").PasteSpecial xlPasteValues
                Sheets(Lead.Value).Range("A2").PasteSpecial xlPasteFormats
                Sheets(Lead.Value).Rows("1:1").AutoFilter
        End If
    Next Lead

    b.Range("h4").Resize(b.Range("h1") - 1, 1).ClearContents
    b.Range("g3").Resize(b.Range("h1"), 1).ClearContents

    Sheets("Template").Visible = False

    ActiveWorkbook.Protect Password:="password", Structure:=True, Windows:=False
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Any suggestions or ideas on how to fix or workaround the issue I am having? I've searched around on the web and on this board and wasn't able to find any real solutions.

Thanks again for the help!
 
Last edited:
Upvote 0
If you have code running in a workbook, and that code closes the workbook it's in, that code is done running, right?

Yes, an add-in would be a good place to put it. It would typically go (in XP) in

C:\Documents and Settings\username\Application Data\Microsoft\AddIns

If you want to put it someplace else (like where you keep other add-ins), put a link in that directory to your directory.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Script crashes - sometimes
Replies
7
Views
219
cowboysnut
C
J
  • Question
Run time error with VBA to copy Chart objects from closed workbook
Replies
4
Views
116
Domenic
D
M
  • Question
Error 1004 - Can't Copy as Picture, but only on certain computer
2
Replies
10
Views
325
rlv01
R
L
  • Question
Run-time error '1004' Unable to get the Vlookup property of the WorksheetFunction class
Replies
5
Views
539
dreid1011
dreid1011
T
  • Question
Run-time error '429': ActiveX component can't create object
Replies
0
Views
228
TheSardOz
T

Forum statistics

Threads
1,215,040
Messages
6,122,806
Members
449,095
Latest member
m_smith_solihull

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top