One may need to
copy or append data or rows from one Excel Office software workbook to another.
Macros can be used to
copy data from one Excel workbook to another. To write Macros for Excel, some knowledge of programming concepts such as
if-else loops and
subroutines may prove useful. As
pre-written Macros are widely available online, it may not be necessary to
write Macros from scratch. Instead, it is best to download a
Macro to copy or append data from one Excel workbook to another and edit it to match the specific requirements of the task.
[Excel] Macro to copy data from one workbook to another
Issue
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 workbooks is the same.
Solution
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
Note
Thanks to
rivisa1 for this tip on the forum.
See also
Knowledge communities.
Published by
aakai1056 -
Latest update by Celia Gatward