Run time error 1004 Applicatin-defined or object-defined error (Copy from src to dest

Joined
Oct 12, 2012
Messages
1
Reaction score
0
i Guys,
I am new to Excel VBA. I have got a situation where i need your help.
I have a source file and a destination file. Basically what i have to do is copy some cols from source file to destination file.
Say for example if i have 10 cols in Source file and 20 cols in destination file. I have to copy those 10 cols and paste
them across the destination file where the cols match. the cols are in fixed order so i do not want to search a string to find the corresponding col in the
destination file as i know they are fixed. i want to just match the cols. say A to B or C to C etc..
For example if there was to be a col in source file called Cust_no in col C, I know Cust_no is destination file is Col A. So i have to copy the col c from source and find the last line of col A in destination and paste it. I want to do this for all 10 cols
But basic criteria is i want to check the last row of the Col A in source file and store it in a dummy variable and then use that as a reference to copy
the rest of cols in source file as some of the cols might have blank values (so cant use End(xldown)) and Col A does not have a blank value.
Then go into destination file find the last available line of Col A as they are always populated and cannot be blank and store it in a dummy variable and
then use that reference for copying the rest of the cols.

For example
My first sheet has 10 cols. Last line of the first col A is 15. So i store it in a dummy variable and use 15 as a reference and copy that 15 lines across all cols in source.
Then go to destination find the last line of the first col A. Lets say 30. Then paste each col from source to destination on 30th line for all the cols in destination file.


I have written a a VB script for doing that. But it may not be very efficient one as i am a newbiew. but i am getting an run time error 1004.
Can you guys help me to rectify it and also suggest me is there a better way to do the above proccess?

My code :
Sub GenerateReport3()
Application.ScreenUpdating = False

Dim LastRow_s As Long
Dim LastRow_t As Long

Dim sBook_t As String
Dim sBook_s As String

Dim sSheet_t As String
Dim sSheet_s As String


Dim sRange_s As String
Dim sRange_t As String


sBook_t = "test1.xls"
sBook_s = "test.xls"

sSheet_t = "Sheet1"
sSheet_s = "Sheet1"

'With ActiveSheet
'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'End With

LastRow_t = Workbooks(sBook_t).Sheets(sSheet_t).Cells(Rows.Count, "A").End(xlUp).Row
LastRow_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(Rows.Count, "A").End(xlUp).Row


'Column match for "A"

Workbooks(sBook_s).Activate
Sheets(sSheet_s).Select
sRange_s = "A2" & ":" & "A" & LastRow_s
Range(sRange_s).Select
'Range(Selection, Selection.End(xlDown)).Select
'Range(A2:sRange_s).Offset(1, 0).Select
Selection.Copy
Workbooks(sBook_t).Activate
Sheets(sSheet_t).Select
sRange_t = "A" & LastRow_t

Range(sRange_t).Offset(1, 0).Select
'Range(sRange_t).Select
Selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.SaveAs "c:\Opensource\test1.xls"

'Workbooks("test.xls").Activate
'Sheets("sheet1").Select
'Range("A1").Select

'Column match for "B"

Workbooks(sBook_s).Activate
Sheets(sSheet_s).Select
sRange_s = "B2" & ":" & "B" & LastRow_s
Range(sRange_s).Select
'Range(Selection, Selection.End(xlDown)).Select
'Range(B2:sRange_s).Offset(1, 0).Select
Selection.Copy
Workbooks(sBook_t).Activate
Sheets(sSheet_t).Select
sRange_t = "B" & LastRow_t

Range(sRange_t).Offset(1, 0).Select
'Range(sRange_t).Select
Selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.SaveAs "c:\Opensource\test1.xls"

'Workbooks("test.xls").Activate
'Sheets("sheet1").Select
'Range("B1").Select

etc.... (for all the cols you wanna copy)


'Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Please help me guys.
 
Joined
Nov 11, 2012
Messages
17
Reaction score
1
Code:
Sub Send_to_next_WB()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim clRng As Range
    Dim cl1 As Integer, cr1 As Range, fCol As Integer
    Dim sRws As Long, sCol As Integer, sr As Range, sfRng As Range, cs As Range

    Set wb1 = Workbooks("Source WB.xlsm")
    Set wb2 = Workbooks("Dest WB.xlsx")
    Set sh1 = wb1.Worksheets("Sheet1")
    Set sh2 = wb2.Worksheets("Sheet1")

    Set r = Range("A1")
    sRws = sh1.Cells.Find(What:="*", After:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sCol = sh1.Cells.Find(What:="*", After:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Set sfRng = Range(sh1.Cells(sRws, 1), sh1.Cells(sRws, sCol))

    For Each cs In sfRng.Cells
        cl1 = cs.Column
        Set cr1 = sh1.Cells(1, cl1)

        fCol = sh2.Cells.Find(What:=cr1, After:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Set dRng = sh2.Cells(Rows.Count, fCol).End(xlUp).Offset(1, 0)

     cs.Copy Destination:=dRng

    Next cs

End Sub
Check out the example workbooks
Open both workbooks.
The code is run from the macro workbook
http://www.davesexcel.com/Dest WB.xlsx
http://www.davesexcel.com/Source WB.xlsm
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top