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
16
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.
 

EC1728

New Member
Joined
May 12, 2021
Messages
16
Office Version
  1. 2016
Platform
  1. Windows
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
@rlv01

I had to make one modification to code or I would get a pop up that says - There's already data here. Do you want to replace it?

I made the following change:

VBA Code:
WS.UsedRange.Copy
    With Range("A1")
    .PasteSpecial (xlPasteColumnWidths)
    .PasteSpecial xlPasteAll
    .Select
    Application.CutCopyMode = False
    End With

I think this takes care of the column widths first then pastes everything else. Which brings me to the next question. I have tried to find a solution but can't seem to get it right. How do I go about making it paste the same row heights? I guess I should have also thought of that before when thinking about the column widths.

Also, not sure if this is asking too much but I do have some vba code in the worksheet coding that executes when there is a worksheet change. When I was duplicating and coping the sheet the vba sheet code copied over. With the method we are attempting to use the vba code does not copy over. Any ideas?

Again, I really appreciate all the help. Have been trying to figure this out on my own but keep getting stumped.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
2,115
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@EC1728 You might try adding the following subroutine:

VBA Code:
Sub CopyRowHeigths(TargetRange As Range, SourceRange As Range)
'
    Dim CurrentRow As Long
'
    Application.ScreenUpdating = False
'
    With SourceRange
        For CurrentRow = 1 To .Rows.Count
            TargetRange.Rows(CurrentRow).RowHeight = .Rows(CurrentRow).RowHeight
        Next CurrentRow
    End With
'
    Application.ScreenUpdating = True
End Sub

And then add the following after the 'End With" in your last post:

VBA Code:
Call CopyRowHeigths(WS.UsedRange, DestWS.Range("A1"))

I think that /\ /\ /\ will send the proper ranges to the subroutine to 'CopyRowHeigths'
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,174
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
@rlv01
....but I do have some vba code in the worksheet coding that executes when there is a worksheet change. When I was duplicating and coping the sheet the vba sheet code copied over
Yeah, that's a pretty significant piece of information. First, before getting into programming the code module, as an experiment I'd recommend going back to your original copy code and try this variation to see if it was the event code in your worksheet that was messing up the copy operation:

VBA Code:
Sub CopyActiveSheet()
    Application.EnableEvents = False
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Application.EnableEvents = True
End Sub
 

EC1728

New Member
Joined
May 12, 2021
Messages
16
Office Version
  1. 2016
Platform
  1. Windows
Yeah, that's a pretty significant piece of information. First, before getting into programming the code module, as an experiment I'd recommend going back to your original copy code and try this variation to see if it was the event code in your worksheet that was messing up the copy operation:

VBA Code:
Sub CopyActiveSheet()
    Application.EnableEvents = False
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Application.EnableEvents = True
End Sub

This code worked to make one copy then on the second attempt I received the Run-time error again. Highlights this line ActiveSheet.Copy After:=Sheets(Sheets.Count)
 

rlv01

Well-known Member
Joined
May 16, 2017
Messages
1,174
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
This code worked to make one copy then on the second attempt I received the Run-time error again. Highlights this line ActiveSheet.Copy After:=Sheets(Sheets.Count)

Back to the workaround it is.....

VBA Code:
''' IMPORTANT: Requires the 'Microsoft Visual Basic for Applications Extensibility 5.3' reference to be enabled.
Sub CopyActiveSheet()
    Dim WB As Workbook, DestWS As Worksheet, WS As Worksheet
    Dim SName As String
    Dim N As Long
    Dim S As String
    
    Set WB = ActiveSheet.Parent
    Set WS = ActiveSheet
    Application.ScreenUpdating = False
    
    'Add new sheet, copy data
    Set DestWS = WB.Worksheets.Add(After:=WB.Sheets(WB.Sheets.Count))
    WS.UsedRange.Copy
    With DestWS.Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteColumnWidths
        .Select
    End With
    
    'Copy any code
    With WB.VBProject
        S = ""
        With .VBComponents(WS.CodeName).CodeModule
            If .CountOfLines > 0 Then
                S = .Lines(1, .CountOfLines)
            End If
        End With
        With .VBComponents(DestWS.CodeName).CodeModule
            If .CountOfLines > 0 Then
                .DeleteLines 1, .CountOfLines
            End If
            .AddFromString S
        End With
    End With
    
    '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 & ")"
    Application.ScreenUpdating = True
    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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,392
Messages
5,769,816
Members
425,574
Latest member
grimeslisa

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
Top