Move or Copy sheet not working / Also VBA Run-time error ‘1004’: Copy method of Worksheet class failed

EC1728

New Member
Joined
May 12, 2021
Messages
18
Office Version
  1. 2016
Platform
  1. Windows
Good morning everyone. I have recently run into the following problem:

I have searched the forum along with numerous other sites and can't seem to find the solution to my problem. I am currently using Excel 2016 (Microsoft Office Professional Plus).

I have a sheet named 29A-1 and I am attempting to make numerous copies of the same worksheet. I have attempted to right-click on the sheet tab, select Move or Copy, then check the Create a copy box. I have also attempted holding Ctrl then clicking on the tab and dragging it to the end. The sheet and workbook are not protected.

I have also tried the following VBA Code:

Sub CopyActiveSheet()
ActiveSheet.Copy After:=Sheets(Sheets.Count)
End Sub

The VBA code will work one time and then on the second attempt it throws the Run-time error ‘1004’: Copy method of Worksheet class failed. If I reset the code it will work again one time then error again on the second time.

Basically what I end up with is tabs that look like this:

29A-1 29A-1 (2) Sheet3 29A-1 (3) Sheet5

Sheet3 and Sheet5 are completely blank. I am getting similar results when I use the Move or Copy option and clicking Ctrl then dragging the tab. Anyone have any ideas on what the issue might be or how I can fix it.

Thank you and I appreciate any help.
 
Though I have not seen it, there have been some reports of problems with copying too many sheets without saving the workbook, so this might be worth a try as an experiment:

VBA Code:
Sub CopyActiveSheet()
    Dim WB As Workbook
   
    Set WB = ActiveSheet.Parent
    ActiveSheet.Copy After:=WB.Sheets(WB.Sheets.Count)
    WB.Save
End Sub

If you have a lot of formulas on the sheets you are trying to copy then another test might be:

VBA Code:
Sub CopyActiveSheet()
    Dim WB As Workbook
   
    Set WB = ActiveSheet.Parent
    Application.Calculation = xlCalculationManual
    ActiveSheet.Copy After:=WB.Sheets(WB.Sheets.Count)
End Sub

(Don't forget to turn calculation back on after the test)

When I used the first code it successfully made a copy of the active sheet then saved. I attempted to use it again and it generated a blank sheet and I received the Run-time error again.

The second code generated a blank sheet and I received the Run-time error.

I have approximately 1100 formulas on the sheet I am trying to create a copy of.

I also have another template sheet that gets populated from a userform then once it's populated I have a code that copies the template sheet then names it based on a cell value. I am occasionally receiving the Run-Time error when executing that code.
 
Upvote 0

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Instead of copying the sheets to the same workbook, if you copy the sheets to a new workbook, do you get the same error?

VBA Code:
Sub CopyActiveSheet()
    Dim WS As Worksheet
    Dim TmpWB As Workbook
    Dim I As Long
    
    Set WS = ActiveSheet
    Set TmpWB = Workbooks.Add
    
    For I = 1 To 10
        With TmpWB
            WS.Copy After:=.Sheets(.Sheets.Count)
        End With
    Next I
End Sub
 
Upvote 0
Instead of copying the sheets to the same workbook, if you copy the sheets to a new workbook, do you get the same error?

VBA Code:
Sub CopyActiveSheet()
    Dim WS As Worksheet
    Dim TmpWB As Workbook
    Dim I As Long
   
    Set WS = ActiveSheet
    Set TmpWB = Workbooks.Add
   
    For I = 1 To 10
        With TmpWB
            WS.Copy After:=.Sheets(.Sheets.Count)
        End With
    Next I
End Sub

I ran this code and received the attached error message. Run-Time error '1004': Can't move focus to the control because it is invisible, not enabled, or of a type that does not accept focus.

When I debug the following line is highlighted: WS.Copy After:=.Sheets(.Sheets.Count) When I hover over it says .Sheets.Count=5

In the New(TmpWB) Workbook it looks like this:

Sheet1, 29A-1, 29A-1(2), 29A-1(3), Sheet5

Sheet1 and Sheet5 are blank. All the 29A-1 sheets are good copies of my ActiveSheet.

I've found other examples where others have run into this situation. Not sure if there is a solid solution to fix the problem or if I need to have Excel reinstalled.
 

Attachments

  • Capture3.PNG
    Capture3.PNG
    8.6 KB · Views: 9
Upvote 0
Instead of copying the sheets to the same workbook, if you copy the sheets to a new workbook, do you get the same error?

VBA Code:
Sub CopyActiveSheet()
    Dim WS As Worksheet
    Dim TmpWB As Workbook
    Dim I As Long
   
    Set WS = ActiveSheet
    Set TmpWB = Workbooks.Add
   
    For I = 1 To 10
        With TmpWB
            WS.Copy After:=.Sheets(.Sheets.Count)
        End With
    Next I
End Sub

I opened up a brand new workbook and ran this code. I received the Run-time error '1004': Method 'Copy' of object'_Wooksheet' failed

Debug highlights WS.Copy After:=.Sheets(.Sheets.Count)

It created a new workbook

Sheet1, 29A-1, Sheet3

Sheet1 and Sheet3 are blank

29A-1 is a good copy
 

Attachments

  • Capture4.PNG
    Capture4.PNG
    8.7 KB · Views: 8
Upvote 0
At this point, I think the issue is not the code, but some as yet unidentified problem with your Excel installation, or perhaps some kind of interaction with something else installed on your PC. I recently experienced one of these anomalies myself (VBA 'SHELL' command causes Excel freeze up on new 64bit PC w/64 bit Office).

Though it would be better to find and resolve the root cause, one workaround that may or may not work would be to avoid the worksheet copy method and instead write some code that would use the add method to create a new blank worksheet and then copy the contents from the source sheet on to the new sheet.
 
Upvote 0
@EC1728 Try the following code out to see if you are able to atleast open multiple blank sheets rapidly:

VBA Code:
Sub AddBlankSheetsTest()
'
    SheetName = ActiveSheet.Name                                            ' Set the name of the new sheet to create
'
    For I = 2 To 11                                                         ' Loop for creating new blank sheets
        Sheets.Add(After:=ActiveSheet).Name = SheetName & "(" & I & ")"     '   insert a new Sheet AFTER the Active Sheet and specify the New Sheet name
    Next                                                                    ' Loop back to start of loop until all desired sheets are made
End Sub
 
Upvote 0
@EC1728 Try the following code out to see if you are able to atleast open multiple blank sheets rapidly:

VBA Code:
Sub AddBlankSheetsTest()
'
    SheetName = ActiveSheet.Name                                            ' Set the name of the new sheet to create
'
    For I = 2 To 11                                                         ' Loop for creating new blank sheets
        Sheets.Add(After:=ActiveSheet).Name = SheetName & "(" & I & ")"     '   insert a new Sheet AFTER the Active Sheet and specify the New Sheet name
    Next                                                                    ' Loop back to start of loop until all desired sheets are made
End Sub
@johnnyL

I was able to run this code multiple times without issue.
 
Upvote 0
@johnnyL

I was able to run this code multiple times without issue.
So if that works, then potentially a workaround using .add instead of .copy is feasible.

One example:

VBA Code:
Sub CopyActiveSheet()
    Dim WB As Workbook, DestWS As Worksheet, WS As Worksheet
    Dim SName As String
    Dim N As Long
    
    Set WB = ActiveSheet.Parent
    Set WS = ActiveSheet
    Set DestWS = WB.Worksheets.Add(After:=WB.Sheets(WB.Sheets.Count))
    
    WS.UsedRange.Copy DestWS.Range("A1")
    
    'new sheet name code. There may be a more elegant way.
    N = 2
    SName = Trim(Split(WS.Name, "(")(0))
    On Error GoTo NextName
    DestWS.Name = SName & " (" & N & ")"
    Exit Sub
NextName:
N = N + 1 'try the next one
If N > 250 Then Exit Sub    'safety exit in case of unknown problem
Resume
End Sub
 
Upvote 0
So if that works, then potentially a workaround using .add instead of .copy is feasible.

One example:

VBA Code:
Sub CopyActiveSheet()
    Dim WB As Workbook, DestWS As Worksheet, WS As Worksheet
    Dim SName As String
    Dim N As Long
   
    Set WB = ActiveSheet.Parent
    Set WS = ActiveSheet
    Set DestWS = WB.Worksheets.Add(After:=WB.Sheets(WB.Sheets.Count))
   
    WS.UsedRange.Copy DestWS.Range("A1")
   
    'new sheet name code. There may be a more elegant way.
    N = 2
    SName = Trim(Split(WS.Name, "(")(0))
    On Error GoTo NextName
    DestWS.Name = SName & " (" & N & ")"
    Exit Sub
NextName:
N = N + 1 'try the next one
If N > 250 Then Exit Sub    'safety exit in case of unknown problem
Resume
End Sub
@rlv01

I was able to make 10 copies without throwing the Run-time error. So that's definitely a great start!!

The only issue is when the sheet is added it does not keep the same column widths as the sheet being copied. All the columns come out equal in size (8.43).

Not sure if you know a solution to keep the column widths all the same so the new sheet is an exact copy, but if you do then this problem will be completely resolved.

Fingers crossed as that would completely save this project.

Thank you for everything so far!!!
 
Upvote 0
Replace this

VBA Code:
   WS.UsedRange.Copy DestWS.Range("A1")

with this

VBA Code:
    WS.UsedRange.Copy
    With DestWS.Range("A1")
    .PasteSpecial (xlPasteAll)
    .PasteSpecial (xlPasteColumnWidths)
    .Select
    End With
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

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