Run-time error 1004: method range of object worksheet failed

J

jwb1012

Board Regular
Joined
Oct 17, 2016
Messages
167
Hello everyone, I am attempting to use the macro below, but for some reason the last section of the code (specific line item bolded and underlined) results in an error.

"Run-time error 1004: method range of object worksheet failed"

Any thoughts on why this is happening and how I can fix this?


Code: 
Sub Res_Hrs_Cost()
    Dim wb As ThisWorkbook
    Dim Sh As Worksheet
    Dim CopyRng As Range
    
    Dim Pricing As Worksheet
    Dim BaseDate As Range
    Dim BaseDate_Full As Range
    Dim Month_2_Full As Range
    Dim Heading_Month_1 As Range
    Dim Num_Months As Integer
    
    Dim Dest_Sh As Worksheet
    Dim Dest_Start_Row As Integer
    Dim Dest_End_Row As Integer
    Dim Dest_End_Column As Integer
    
    Dim Dest_Start_Row_2 As Integer
    Dim Dest_End_Row_2 As Integer
    
    Dim Source_Sh As Worksheet
    Dim Source_Start_Row As Integer
    Dim Source_End_Row As Integer
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''        '(1.) Clear contents from destination worksheet
        Set Dest_Sh = Sheets("DESTINATION")
            Dest_End_Row = Dest_Sh.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
            Dest_End_Column = Dest_Sh.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
            On Error Resume Next
                Dest_Sh.Visible = True
                Dest_Sh.Activate
            On Error GoTo 0
            
                If Dest_End_Row > 1 Then
                    Dest_Sh.Rows("2:" & Dest_End_Row).EntireRow.Delete
                End If
                
                If Dest_End_Column > 50 Then
                    Dest_Sh.Range(Cells(1, 9), Cells(1, Dest_End_Column)).EntireColumn.Delete
                End If
                
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '(2.) Copy source data and paste to destination worksheet
        Set Source_Sh = Sheets("SOURCE")
            Source_End_Row = Source_Sh.Range("K" & Rows.Count).End(xlUp).Row
                
            On Error Resume Next
                Dest_Sh.Visible = True
                Dest_Sh.Activate
            On Error GoTo 0
            
                'COPY RANGE - 1
                Dest_Start_Row = Dest_Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
                Set CopyRng = Source_Sh.Range("B14", "B" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("A" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                        
                'COPY RANGE - 2
                Dest_End_Row_2 = Dest_Sh.Cells(Rows.Count, "A").End(xlUp).Row
                Set CopyRng = Source_Sh.Range("K14", "K" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("B" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                        
                'COPY RANGE - 3
                Set CopyRng = Source_Sh.Range("AA14", "AA" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("C" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                'INSERT - 1
                If Dest_End_Row > 1 Then
                    Dest_Sh.Range(Cells(Dest_Start_Row, 7), Cells(Dest_End_Row_2, 7)).Formula = "D"
                End If
                
                'COPY RANGE - 4
                Set Pricing = Sheets("Pricing")
                    Pricing.Visible = True
                        Set BaseDate = Pricing.Range("$I$16")
                                BaseDate.Copy
                                With Dest_Sh.Range("H" & Dest_Start_Row, "H" & Dest_End_Row_2)
                                    .PasteSpecial xlPasteValues
                                    Application.CutCopyMode = False
                                End With
                                
                        Set BaseDate_Full = Pricing.Range("$I$14")
                                BaseDate_Full.Copy
                                With Dest_Sh.Range("$I$1")
                                    .PasteSpecial xlPasteValues
                                    Application.CutCopyMode = False
                                End With
                                
                'MONTH HEADINGS!
                On Error Resume Next
                    Dest_Sh.Visible = True
                    Dest_Sh.Activate
                On Error GoTo 0
                
                Set Heading_Month_1 = Dest_Sh.Range("$I$1")
                Num_Months = Pricing.Range("$I$19")
                    If Heading_Month_1 > 0 Then
                        Dest_Sh.Range(Cells(1, 10), Cells(1, 8 + Num_Months)).Formula = "=DATE(YEAR(I$1),MONTH(I$1)+1,DAY(I$1))"
                    End If
                    
                'COPY RANGE - 5
[I][U][B]                Set CopyRng = Source_Sh.Range(Cells(14, 50), Cells(Source_End_Row, 49 + Num_Months))[/B][/U][/I]
                        CopyRng.Copy
                        With Dest_Sh.Range(Cells(Dest_Start_Row, 9), Cells(Dest_End_Row_2, 8 + Num_Months))
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                                        
                        
ExitTheSub:
    Application.GoTo Dest_Sh.Cells(1)
    ActiveWindow.DisplayGridlines = False
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
Try this.
Code: 
With Source_Sh
    Set CopyRng = .Range(.Cells(14, 50), .Cells(Source_End_Row, 49 + Num_Months))
End With

Note you might need to use similar fixes in other places in the code, for example here.
Code: 
 Dest_Sh.Range(Cells(1, 10), Cells(1, 8 + Num_Months)).Formula = "=DATE(YEAR(I$1),MONTH(I$1)+1,DAY(I$1))"

The problem with this line of code, and the one you originally mentioned, is that there is no sheet reference for Cells.

Without a sheet reference Cells will refer to the currently active sheet and if that, in this example, isn't Dest_Sh the code will fail.

The code above can be 'fixed' like this,
Code: 
With Dest_Sh
    .Range(.Cells(1, 10), .Cells(1, 8 + Num_Months)).Formula = "=DATE(YEAR(I$1),MONTH(I$1)+1,DAY(I$1))"
End With

though are other ways - you might want to take a look at using Resize.
 
Upvote 0
Thank you very much for the quick response, and for going into detail about the issue.

For some reason, the fix didn't work - but I believe the logic gets at the source of the issue. I removed the line of code below:

Code: 
                'MONTH HEADINGS!
                On Error Resume Next
                    Dest_Sh.Visible = True
                    Dest_Sh.Activate
                On Error GoTo 0


But, now it's not throwing up a red flag 2 lines below:

Code: 
 With Dest_Sh.Range(Cells(Dest_Start_Row, 9), Cells(Dest_End_Row_2, 8 + Num_Months))

I also tried to add in a few lines that re-set the source sheet to the active sheet and I got the same result as above.

Code: 
                'MONTH HEADINGS!
                On Error Resume Next
                    Dest_Sh.Visible = True
                    Dest_Sh.Activate
                On Error GoTo 0
                
                Set Heading_Month_1 = Dest_Sh.Range("$I$1")
                Num_Months = Pricing.Range("$I$19")
                    If Heading_Month_1 > 0 Then
                        Dest_Sh.Range(Cells(1, 10), Cells(1, 8 + Num_Months)).Formula = "=DATE(YEAR(I$1),MONTH(I$1)+1,DAY(I$1))"
                    End If
                    
                                    'COPY RANGE - 5
                On Error Resume Next
                    Source_Sh.Visible = True
                    Source_Sh.Activate
                On Error GoTo 0
                
                With Source_Sh
                    Set CopyRng = Source_Sh.Range(Cells(14, 50), Cells(Source_End_Row, 49 + Num_Months))
                End With
                        CopyRng.Copy
                        With Dest_Sh.Range(Cells(Dest_Start_Row, 9), Cells(Dest_End_Row_2, 8 + Num_Months))
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                                        
                        
ExitTheSub:
    Application.GoTo Dest_Sh.Cells(1)
    ActiveWindow.DisplayGridlines = False
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 
Upvote 0
Ahh!!! I'm sorry - let me take that back... it worked! I removed the lines of code below and added in your 'fix' and it worked! THANK YOU!!

Is this the approach you would use to accomplish this task or would you use an alternative method such as resize (as mentioned above)?

Code: 
                On Error Resume Next
                    Dest_Sh.Visible = True
                    Dest_Sh.Activate
                On Error GoTo 0


Code: 
                On Error Resume Next
                    Source_Sh.Visible = True
                    Source_Sh.Activate
                On Error GoTo 0



UPDATED CODE:
Code: 
Sub Res_Hrs_Cost()
    Dim wb As ThisWorkbook
    Dim Sh As Worksheet
    Dim Pricing As Worksheet
    
    Dim CopyRng As Range
    Dim BaseDate As Range
    Dim BaseDate_Full As Range
    Dim Heading_Month_1 As Range
    Dim Num_Months As Integer
    
    Dim Dest_Sh As Worksheet
    Dim Dest_Start_Row As Integer
    Dim Dest_End_Row As Integer
    Dim Dest_End_Column As Integer
    
    Dim Dest_Start_Row_2 As Integer
    Dim Dest_End_Row_2 As Integer
    
    Dim Source_Sh As Worksheet
    Dim Source_Start_Row As Integer
    Dim Source_End_Row As Integer
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '(1.) Clear contents from destination worksheet
        Set Dest_Sh = Sheets("DESTINATION")
            Dest_End_Row = Dest_Sh.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
            Dest_End_Column = Dest_Sh.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
            On Error Resume Next
                Dest_Sh.Visible = True
                Dest_Sh.Activate
            On Error GoTo 0
            
                If Dest_End_Row > 1 Then
                    Dest_Sh.Rows("2:" & Dest_End_Row).EntireRow.Delete
                End If
                
                If Dest_End_Column > 50 Then
                    Dest_Sh.Range(Cells(1, 9), Cells(1, Dest_End_Column)).EntireColumn.Delete
                End If
                
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '(2.) Copy source data and paste to destination worksheet
        Set Source_Sh = Sheets("SOURCE")
            Source_End_Row = Source_Sh.Range("K" & Rows.Count).End(xlUp).Row
                
            On Error Resume Next
                Dest_Sh.Visible = True
                Dest_Sh.Activate
            On Error GoTo 0
            
                'COPY RANGE - 1
                Dest_Start_Row = Dest_Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
                Set CopyRng = Source_Sh.Range("B14", "B" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("A" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                        
                'COPY RANGE - 2
                Dest_End_Row_2 = Dest_Sh.Cells(Rows.Count, "A").End(xlUp).Row
                Set CopyRng = Source_Sh.Range("K14", "K" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("B" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                        
                'COPY RANGE - 3
                Set CopyRng = Source_Sh.Range("AA14", "AA" & Source_End_Row)
                        CopyRng.Copy
                        With Dest_Sh.Range("C" & Dest_Start_Row)
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                'INSERT - 1
                If Dest_End_Row > 1 Then
                    Dest_Sh.Range(Cells(Dest_Start_Row, 7), Cells(Dest_End_Row_2, 7)).Formula = "D"
                End If
                
                'COPY RANGE - 4
                Set Pricing = Sheets("Pricing")
                    Pricing.Visible = True
                        Set BaseDate = Pricing.Range("$I$16")
                                BaseDate.Copy
                                With Dest_Sh.Range("H" & Dest_Start_Row, "H" & Dest_End_Row_2)
                                    .PasteSpecial xlPasteValues
                                    Application.CutCopyMode = False
                                End With
                                
                        Set BaseDate_Full = Pricing.Range("$I$14")
                                BaseDate_Full.Copy
                                With Dest_Sh.Range("$I$1")
                                    .PasteSpecial xlPasteValues
                                    Application.CutCopyMode = False
                                End With
                                
                'MONTH HEADINGS!
                Set Heading_Month_1 = Dest_Sh.Range("$I$1")
                Num_Months = Pricing.Range("$I$19")
                    If Heading_Month_1 > 0 Then
                        Dest_Sh.Range(Cells(1, 10), Cells(1, 8 + Num_Months)).Formula = "=DATE(YEAR(I$1),MONTH(I$1)+1,DAY(I$1))"
                    End If
                    
                    
                'COPY RANGE - 5
                With Source_Sh
                    Set CopyRng = Source_Sh.Range(Cells(14, 50), Cells(Source_End_Row, 49 + Num_Months))
                End With
                        CopyRng.Copy
                        With Dest_Sh.Range(Cells(Dest_Start_Row, 9), Cells(Dest_End_Row_2, 8 + Num_Months))
                            .PasteSpecial 8    ' Column width
                            .PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                        End With
                                        
                        
ExitTheSub:
    Application.GoTo Dest_Sh.Cells(1)
    ActiveWindow.DisplayGridlines = False
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Chris_010101
  • Solved
Error 1004
Replies
3
Views
190
Domenic
D
2
  • Question
Run=time error '1004': Method 'Range of Object'_Global' failed
Replies
4
Views
325
2077delta
2
G
  • Question
error 1004 method intersect of object _global failed
2
Replies
12
Views
360
rlv01
R
F
  • Question
Error 1004 on VlookUp
Replies
5
Views
240
Anthony47
A
S
  • Solved
Run-time error '1004': No cells were found.
Replies
4
Views
560
sspatriots
S

Forum statistics

Threads
1,215,065
Messages
6,122,944
Members
449,095
Latest member
nmaske

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