Dear friends,
I have a challenge on achieving the below project, kindly please assist:
- I have four source workbooks with names(GK,SK,RJ and TB)
- Each workbook(GK,SK,RJ and TB) have three worksheets with the same names(products, channels, and sales).
- I have another one workbook called consolidated workbook with the same worksheets names(products, channels, and sales) like those of the four source workbooks.
- I want a code that will copy data from each worksheet of all the four source workbooks and transfer/paste the data to worksheets in consolidated workbook based on the rows that were not previously copied from the last copy event.
- Currently I have the below code but whenever I ran it copies everything from worksheets on the source workbooks and paste to worksheets in consolidated workbook which result to duplicated data.
I have a challenge on achieving the below project, kindly please assist:
- I have four source workbooks with names(GK,SK,RJ and TB)
- Each workbook(GK,SK,RJ and TB) have three worksheets with the same names(products, channels, and sales).
- I have another one workbook called consolidated workbook with the same worksheets names(products, channels, and sales) like those of the four source workbooks.
- I want a code that will copy data from each worksheet of all the four source workbooks and transfer/paste the data to worksheets in consolidated workbook based on the rows that were not previously copied from the last copy event.
- Currently I have the below code but whenever I ran it copies everything from worksheets on the source workbooks and paste to worksheets in consolidated workbook which result to duplicated data.
VBA Code:
Sub Copy_From_All_Workbooks()
Dim wb As String, i As Long, sh As Worksheet
Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
If wb <> ThisWorkbook.Name Then
Workbooks.Open ThisWorkbook.Path & "\" & wb
For Each sh In Workbooks(wb).Worksheets
sh.UsedRange.Offset(1).Copy '<---- Assumes 1 header row
ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next sh
Workbooks(wb).Close False
End If
wb = Dir
Loop
Application.ScreenUpdating = True
End Sub