Run-time Error '1004': Application-defined or object-defined error.

[whoosh]

Dear Gurus,

The above-mentioned error keeps popping up when I execute the code below. It was running perfectly fine till I switched the sourceWB workbook and made changes to the code to reflect the change.

Since the change, i could not get the macro to run and it is driving me crazy.
Hope someone can help to highlight what could be the possible cause of this error.


Thanks in advance.

Option Explicit

Sub CopyExtRes_FRBO()
'
' Copy from FRBO
'
Dim sourceWB As Workbook, targetWB As Workbook, ws1 As Worksheet, i As Integer
Dim nRow As Long, lRow As Long, sht As String, sheet As Worksheet


Application.ScreenUpdating = False


Set sourceWB = Workbooks("FRBO (Private Apt).xls")
Set targetWB = Workbooks("ck's database_Residential (updating 01 May 2018).xlsm")
Set ws1 = sourceWB.Sheets("Sheet1")
lRow = ws1.Cells(Rows.Count, "B").End(xlUp).Row - 2
With ws1
    For i = 2 To lRow
        sht = .Range("B1") & .Range("B" & i)
            For Each sheet In targetWB.Sheets
                If sheet.Name = sht Then
                    With sheet
                        nRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                        ws1.Range("A" & i).Copy Destination:=.Range("N" & nRow)
                        ws1.Range("C" & i).Copy Destination:=.Range("A" & nRow)
                        ws1.Range("D" & i).Copy Destination:=.Range("R" & nRow)
                        ws1.Range("E" & i).Copy Destination:=.Range("S" & nRow)
                        ws1.Range("F" & i).Copy Destination:=.Range("E" & nRow)
                        ws1.Range("G" & i).Copy Destination:=.Range("M" & nRow)
                        ws1.Range("H" & i).Copy Destination:=.Range("H" & nRow)
                        ws1.Range("I" & i).Copy Destination:=.Range("J" & nRow)
                        ws1.Range("J" & i).Copy Destination:=.Range("O" & nRow)
                        ws1.Range("K" & i).Copy Destination:=.Range("U" & nRow)
                    End With
                End If
            Next sheet
    Next i
End With
Application.ScreenUpdating = True


End Sub

 

[whoosh]

Thanks RasGhul, i checked that many times. File names are correct, and the worksheet as well.

 

[RasGhul]

Unfortunately you have have to retrace your steps back through your changes. Does your code still work if you revert back to your original sourceWB file?

 

[MARK858]

Anyone???

You didn't answer what happened when you made the change Fluff suggested in post number 6.

 

[whoosh]

You didn't answer what happened when you made the change Fluff suggested in post number 6.

Hi MARK858

Tried it, no errors but nothing copied over to the target workbook.

 

[MARK858]

Hi MARK858

Tried it, no errors but nothing copied over to the target workbook.

See Jindon's response in post number 14 in your cross-post... ditto for me.

 

[whoosh]

I think I might have found the problem.
Column B has a header "DT" in the older version file "Res Source wb.xls", but the new version "FRBO (Private Apt).xls" has a header "D" instead. Is it possible to tweet the code to make it run?

Please advise. Thanks!

Option Explicit

Sub CopyExtRes_FRBO()
'
' Copy from FRBO
'
Dim sourceWB As Workbook, targetWB As Workbook, ws1 As Worksheet, i As Integer
Dim nRow As Long, lRow As Long, sht As String, sheet As Worksheet


Application.ScreenUpdating = False


Set sourceWB = Workbooks("FRBO (Private Apt).xls")
Set targetWB = Workbooks("ck's database_Residential (updating 01 May 2018).xlsm")
Set ws1 = sourceWB.Sheets("Sheet1")
lRow = ws1.Cells(Rows.Count, "B").End(xlUp).Row - 2
With ws1
    For i = 2 To lRow
        sht = .Range("B1") & .Range("B" & i)
            For Each sheet In targetWB.Sheets
                If sheet.Name = sht Then
                    With sheet
                        nRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                        ws1.Range("A" & i).Copy Destination:=.Range("N" & nRow)
                        ws1.Range("C" & i).Copy Destination:=.Range("A" & nRow)
                        ws1.Range("D" & i).Copy Destination:=.Range("R" & nRow)
                        ws1.Range("E" & i).Copy Destination:=.Range("S" & nRow)
                        ws1.Range("F" & i).Copy Destination:=.Range("E" & nRow)
                        ws1.Range("G" & i).Copy Destination:=.Range("M" & nRow)
                        ws1.Range("H" & i).Copy Destination:=.Range("H" & nRow)
                        ws1.Range("I" & i).Copy Destination:=.Range("J" & nRow)
                        ws1.Range("J" & i).Copy Destination:=.Range("O" & nRow)
                        ws1.Range("K" & i).Copy Destination:=.Range("U" & nRow)
                    End With
                End If
            Next sheet
    Next i
End With
Application.ScreenUpdating = True


End Sub

 

[whoosh]

Forget to add. The Tab in the target workbook are D1, D2, D3 and so on...