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
5
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.
0
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
0