Runtime 1004 Error

Frazzlerock

New Member
Joined
May 9, 2018
Messages
2
Morning all,


Quite a novice, but I have inherited a migration tool in which it runs a macro and copies all data from various excel spreadsheets and places it onto one master copy


during the process I receive a "run time error 1004 method of rows of object global failed"


the coding looks like this (ive removed the file url and replaced with x's)


********************************************************************************************


Public FSO As Object
Public FromPath As String
Public ToPath As String
Public FileExt As String
Public FNames As String
Public ImportDate As String


Public SourceLastRow1 As Long
Public SourceLastRow2 As Long
Public SourceLastRow3 As Long
Public SourceLastRow4 As Long
Public SourceLastRow5 As Long
Public SourceLastRow6 As Long
Public SourceLastRow7 As Long
Public SourceLastRow8 As Long
Public SourceLastRow9 As Long
Public TargetLastRow1 As Long
Public TargetLastRow2 As Long
Public TargetLastRow3 As Long
Public TargetLastRow4 As Long
Public TargetLastRow5 As Long
Public TargetLastRow6 As Long
Public TargetLastRow7 As Long
Public TargetLastRow8 As Long
Public TargetLastRow9 As Long
Public TargetWB As Workbook
Public SourceWB As Workbook
Public Filename As String


'Public LookupDate As Date
Private ArchivePath As String


Public WeeklyExportDate As String
Public MonthlyExportDate As Date




Sub DataCollection()



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


'***** (1) SET MIGRATED DATA ARCHIVE PATH


ArchivePath = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" & VBA.Strings.Format(ImportDate, "yyyy-mm-dd") & ""


Set TargetWB = ThisWorkbook




'***** (2) IMPORT & COLLATE DATA


Filename = Dir(ArchivePath & "*.xlsm")
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set SourceWB = Workbooks.Open(ArchivePath & Filename)

SourceWB.Sheets("1").Unprotect "CCUED"
SourceWB.Sheets("3").Unprotect "CCUED"
SourceWB.Sheets("4").Unprotect "CCUED"
SourceWB.Sheets("5").Unprotect "CCUED"
SourceWB.Sheets("6").Unprotect "CCUED"
SourceWB.Sheets("7").Unprotect "CCUED"
SourceWB.Sheets("8").Unprotect "CCUED"
SourceWB.Sheets("9").Unprotect "CCUED"

TargetLastRow1 = TargetWB.Sheets("1").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow3 = TargetWB.Sheets("3").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow4 = TargetWB.Sheets("4").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow5 = TargetWB.Sheets("5").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow6 = TargetWB.Sheets("6").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow7 = TargetWB.Sheets("7").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow8 = TargetWB.Sheets("8").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetLastRow9 = TargetWB.Sheets("9").Range("A" & Rows.Count).End(xlUp).Row + 1



'SET SOURCE LAST ROW
On Error Resume Next
SourceWB.Sheets("1").ShowAllData
SourceWB.Sheets("1").AutoFilterMode = False
With SourceWB.Sheets("1").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow1 = SourceWB.Sheets("1").Range("A" & Rows.Count).End(xlUp).Row



SourceWB.Sheets("3").ShowAllData
SourceWB.Sheets("3").AutoFilterMode = False
With SourceWB.Sheets("3").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow3 = SourceWB.Sheets("3").Range("A" & Rows.Count).End(xlUp).Row


SourceWB.Sheets("4").ShowAllData
SourceWB.Sheets("4").AutoFilterMode = False
With SourceWB.Sheets("4").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow4 = SourceWB.Sheets("4").Range("A" & Rows.Count).End(xlUp).Row

SourceWB.Sheets("5").ShowAllData
SourceWB.Sheets("5").AutoFilterMode = False
With SourceWB.Sheets("5").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow5 = SourceWB.Sheets("5").Range("A" & Rows.Count).End(xlUp).Row


SourceWB.Sheets("6").ShowAllData
SourceWB.Sheets("6").AutoFilterMode = False
With SourceWB.Sheets("6").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow6 = SourceWB.Sheets("6").Range("A" & Rows.Count).End(xlUp).Row


SourceWB.Sheets("7").ShowAllData
SourceWB.Sheets("7").AutoFilterMode = False
With SourceWB.Sheets("7").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow7 = SourceWB.Sheets("7").Range("A" & Rows.Count).End(xlUp).Row


SourceWB.Sheets("8").ShowAllData
SourceWB.Sheets("8").AutoFilterMode = False
With SourceWB.Sheets("8").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow8 = SourceWB.Sheets("8").Range("A" & Rows.Count).End(xlUp).Row


SourceWB.Sheets("9").ShowAllData
SourceWB.Sheets("9").AutoFilterMode = False
With SourceWB.Sheets("9").Cells
.EntireColumn.Hidden = False
.EntireRow.Hidden = False
End With
SourceLastRow9 = SourceWB.Sheets("9").Range("A" & Rows.Count).End(xlUp).Row

'COPY DATA TO TARGET
SourceWB.Sheets("1").Range("A2:CO" & SourceLastRow1 + 1).AutoFilter Field:=11, Criteria1:="<>"
SourceWB.Sheets("1").Range("A3:CO" & SourceLastRow1).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("1").Range("A" & TargetLastRow1).PasteSpecial xlPasteValues

SourceWB.Sheets("3").Range("A1:R" & SourceLastRow3 + 1).AutoFilter Field:=2, Criteria1:="<>"
SourceWB.Sheets("3").Range("A2:R" & SourceLastRow3).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("3").Range("A" & TargetLastRow3).PasteSpecial xlPasteValues

SourceWB.Sheets("4").Range("A1:N" & SourceLastRow4 + 1).AutoFilter Field:=8, Criteria1:="<>"
SourceWB.Sheets("4").Range("A2:N" & SourceLastRow4).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("4").Range("A" & TargetLastRow4).PasteSpecial xlPasteValues

SourceWB.Sheets("5").Range("A1:N" & SourceLastRow5 + 1).AutoFilter Field:=6, Criteria1:="<>"
SourceWB.Sheets("5").Range("A2:N" & SourceLastRow5).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("5").Range("A" & TargetLastRow5).PasteSpecial xlPasteValues

SourceWB.Sheets("6").Range("A2:M" & SourceLastRow6 + 1).AutoFilter Field:=7, Criteria1:="<>"
SourceWB.Sheets("6").Range("A3:M" & SourceLastRow6).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("6").Range("A" & TargetLastRow6).PasteSpecial xlPasteValues

SourceWB.Sheets("7").Range("A1:E" & SourceLastRow7 + 1).AutoFilter Field:=6, Criteria1:="<>"
SourceWB.Sheets("7").Range("A2:E" & SourceLastRow7).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("7").Range("A" & TargetLastRow7).PasteSpecial xlPasteValues

SourceWB.Sheets("8").Range("A2:AH" & SourceLastRow8 + 1).AutoFilter Field:=6, Criteria1:="<>"
SourceWB.Sheets("8").Range("A3:AH" & SourceLastRow8).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("8").Range("A" & TargetLastRow8).PasteSpecial xlPasteValues

SourceWB.Sheets("9").Range("A2:D" & SourceLastRow9 + 1).AutoFilter Field:=6, Criteria1:="<>"
SourceWB.Sheets("9").Range("A3:D" & SourceLastRow9).Cells.SpecialCells(xlCellTypeVisible).Copy
TargetWB.Sheets("9").Range("A" & TargetLastRow9).PasteSpecial xlPasteValues

On Error GoTo 0



SourceWB.Close False
Filename = Dir
Loop

TargetLastRow1 = TargetWB.Sheets("1").Range("A" & Rows.Count).End(xlUp).Row + 1
TargetWB.Sheets("1").Range("A1").Copy
TargetWB.Sheets("1").Range("I3:I" & TargetLastRow1 - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
Application.CutCopyMode = False
TargetWB.Sheets("1").Range("I3:I" & TargetLastRow1 - 1).NumberFormat = "0000"


Sheets("Control Panel").Range("B1").Value = "Data last collated: " & VBA.Strings.Format(Now, "DD/MM/YYYY @ HH:MM")


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


Sheets("Control Panel").Select
MsgBox "All Done!"


End Sub


*********************************************************************************************************


the line highlighted in yellow seems to be the issue


can anyone assist me as to what the problem is? what the error message means? how to fix it?


it seems to be when it gets to a particular spreadsheet that the error occurs


Many Thanks
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
If you use "Rows.Count" without qualifying which sheet, you run the risk of the code failing. Also, there was plenty of code duplication so I've tried to tidy it up a bit. This might work but obviously I can't test it:

Code:
Option Explicit

Public FSO As Object
Public FromPath As String
Public ToPath As String
Public FileExt As String
Public FNames As String
Public ImportDate As String

Public SourceLastRow(9) As Long
Public TargetLastRow(9) As Long
Public i As Long
Public TargetWB As Workbook
Public SourceWB As Workbook
Public Filename As String

'Public LookupDate As Date
Private ArchivePath As String

Public WeeklyExportDate As String
Public MonthlyExportDate As Date
Sub DataCollection()

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


'***** (1) SET MIGRATED DATA ARCHIVE PATH
ArchivePath = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" & VBA.Strings.Format(ImportDate, "yyyy-mm-dd") & "\"

Set TargetWB = ThisWorkbook

'***** (2) IMPORT & COLLATE DATA
Filename = Dir(ArchivePath & "*.xlsm")
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN

    Set SourceWB = Workbooks.Open(ArchivePath & Filename)
    
    SourceWB.Sheets("1").Unprotect "CCUED"
    SourceWB.Sheets("3").Unprotect "CCUED"
    SourceWB.Sheets("4").Unprotect "CCUED"
    SourceWB.Sheets("5").Unprotect "CCUED"
    SourceWB.Sheets("6").Unprotect "CCUED"
    SourceWB.Sheets("7").Unprotect "CCUED"
    SourceWB.Sheets("8").Unprotect "CCUED"
    SourceWB.Sheets("9").Unprotect "CCUED"
    
    ' Get last row in target
    For i = 1 To 9
        If i <> 2 Then
            TargetLastRow(i) = TargetWB.Sheets(CStr(i)).Range("A" & TargetWB.Sheets(CStr(i)).Rows.Count).End(xlUp).Row + 1
        End If
    Next i
        
    'SET SOURCE LAST ROW
    On Error Resume Next
    For i = 1 To 9
        If i <> 2 Then
            With SourceWB.Sheets(CStr(i))
                .ShowAllData
                .AutoFilterMode = False
                .Cells.EntireColumn.Hidden = False
                .Cells.EntireRow.Hidden = False
                SourceLastRow(i) = .Range("A" & .Rows.Count).End(xlUp).Row
            End With
        End If
    Next i
    
    'COPY DATA TO TARGET
    SourceWB.Sheets("1").Range("A2:CO" & SourceLastRow(1) + 1).AutoFilter Field:=11, Criteria1:="<>"
    SourceWB.Sheets("1").Range("A3:CO" & SourceLastRow(1)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("1").Range("A" & TargetLastRow(1)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("3").Range("A1:R" & SourceLastRow(3) + 1).AutoFilter Field:=2, Criteria1:="<>"
    SourceWB.Sheets("3").Range("A2:R" & SourceLastRow(3)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("3").Range("A" & TargetLastRow(3)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("4").Range("A1:N" & SourceLastRow(4) + 1).AutoFilter Field:=8, Criteria1:="<>"
    SourceWB.Sheets("4").Range("A2:N" & SourceLastRow(4)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("4").Range("A" & TargetLastRow(4)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("5").Range("A1:N" & SourceLastRow(5) + 1).AutoFilter Field:=6, Criteria1:="<>"
    SourceWB.Sheets("5").Range("A2:N" & SourceLastRow(5)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("5").Range("A" & TargetLastRow(5)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("6").Range("A2:M" & SourceLastRow(6) + 1).AutoFilter Field:=7, Criteria1:="<>"
    SourceWB.Sheets("6").Range("A3:M" & SourceLastRow(6)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("6").Range("A" & TargetLastRow(6)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("7").Range("A1:E" & SourceLastRow(7) + 1).AutoFilter Field:=6, Criteria1:="<>"
    SourceWB.Sheets("7").Range("A2:E" & SourceLastRow(7)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("7").Range("A" & TargetLastRow(7)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("8").Range("A2:AH" & SourceLastRow(8) + 1).AutoFilter Field:=6, Criteria1:="<>"
    SourceWB.Sheets("8").Range("A3:AH" & SourceLastRow(8)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("8").Range("A" & TargetLastRow(8)).PasteSpecial xlPasteValues
    
    SourceWB.Sheets("9").Range("A2:D" & SourceLastRow(9) + 1).AutoFilter Field:=6, Criteria1:="<>"
    SourceWB.Sheets("9").Range("A3:D" & SourceLastRow(9)).Cells.SpecialCells(xlCellTypeVisible).Copy
    TargetWB.Sheets("9").Range("A" & TargetLastRow(9)).PasteSpecial xlPasteValues
    
    On Error GoTo 0
    
    SourceWB.Close False
    Filename = Dir
Loop

TargetLastRow(1) = TargetWB.Sheets("1").Range("A" & TargetWB.Sheets("1").Rows.Count).End(xlUp).Row + 1
TargetWB.Sheets("1").Range("A1").Copy
TargetWB.Sheets("1").Range("I3:I" & TargetLastRow(1) - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
Application.CutCopyMode = False
TargetWB.Sheets("1").Range("I3:I" & TargetLastRow(1) - 1).NumberFormat = "0000"

Sheets("Control Panel").Range("B1").Value = "Data last collated: " & VBA.Strings.Format(Now, "DD/MM/YYYY @ HH:MM")

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

Sheets("Control Panel").Select
MsgBox "All Done!"

End Sub

WBD
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

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