Macro-Copy data from one workbook to another

Closed
Krishna - Apr 22, 2010 at 12:21 AM
 Dvibe - Aug 27, 2015 at 12:13 PM
All, I need to copy data from one workbook and append the content to another workbook (WB).

Ex: WB1 (source) has

1 2 3 4 5

WB2 (target) already have

6 7 8 9 0

After running the macro,

WB2 should have

6 7 8 9 0
1 2 3 4 5

The formats of both the workbooks is same.

This will be of great help.

3 responses

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 23, 2010 at 11:22 AM
Try this. Make sure that you read the NOTE in the code.


Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String

Dim sSheet_t As String
Dim sSheet_s As String

Dim lMaxRows_t As Long
Dim lMaxRows_s As Long

Dim sMaxCol_s As String

Dim sRange_t As String
Dim sRange_s As String

    sBook_t = "Target Data WB- Copy data to WB.xls"
    sBook_s = "Source Data WB - Copy data to WB.xls"
    
    sSheet_t = "Target WB"
    sSheet_s = "Source"
    
    lMaxRows_t = Workbooks(sBook_t).Sheets(sSheet_t).Cells(Rows.Count, "A").End(xlUp).Row
    lMaxRows_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(Rows.Count, "A").End(xlUp).Row
    
    sMaxCol_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(1, Columns.Count).End(xlToLeft).Address
    sMaxCol_s = Mid(sMaxCol_s, 2, InStr(2, sMaxCol_s, "$") - 2)
    
    If (lMaxRows_t = 1) Then
        sRange_t = "A1:" & sMaxCol_s & lMaxRows_s
        sRange_s = "A1:" & sMaxCol_s & lMaxRows_s
        
        Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
            
    Else
        sRange_t = "A" & (lMaxRows_t + 1) & ":" & sMaxCol_s & (lMaxRows_t + lMaxRows_s - 1)
        sRange_s = "A2:" & sMaxCol_s & lMaxRows_s
        
        Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
        
        ' ###################### NOTE #################
        'the following lines are to be used of serial number is to be fixed too, instead of being copied
        ' if there is no need, then delete the line below
        Workbooks(sBook_t).Sheets(sSheet_t).Range("A" & lMaxRows_t).AutoFill Destination:=Workbooks(sBook_t).Sheets(sSheet_t).Range("A" & lMaxRows_t & ":A" & (lMaxRows_t + lMaxRows_s - 1)), Type:=xlFillSeries
    End If
            
End Sub
1st time I run the macro it copied the data, but only 1st row of the source and that too replacing the 1st row of the target. Later on when I run, its giving error 9, "Subscript out of Range".
But my need is that the data from the source should get appended from the last row of the target. For this, I guess, we hav to find the blank cell in column two of target and paste the data from source there on.
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 28, 2010 at 11:35 AM
I just re-tested with the files that you provided. I ran the macro 3 times. It run as per my expectation

https://authentification.site/files/22172909/Target_Data_WB-_Copy_data_to_WB.zip

Try again and if still does not work, upload files with macro and data to some share site and post back the link