How to copy data from four source workbooks to master workbook based on last row that was not previously copied

[MoonLove]

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.

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

 

[MoonLove]

Hi Team,

Anyone to assist..

 

[MoonLove]

Hi Team,

Kindly please assist on the above.

 

[MoonLove]

Dear friends,

No one to assist me on the above ask?

Kindly please help.

 

[Alex Blakenburg]

Incremental data loads are a risky proposition. How is the macro supposed to know what rows are new rows and needed to be added ?

 

[MoonLove]

Hi Alex,

Thank you so much for your response,

The four source workbooks are updated on daily basis meaning data are captured on those source workbooks on daily basis , during evening time, macro is run in order to copy data that has been updated as of today from four source workbooks and paste them in consolidated workbook.

Since the first column of each source workbook - worksheets is a DATE COLUMN, Iam requesting a code that will copy data from the four source workbooks - worksheets and paste them into consolidated workbook - worksheets based on todays added rows/date (the code should not go and copy everything form the source workbook, rather it should only check data added in source workbooks as of today's date and paste them to consolidated workbook).

Please see one of source workbook feature(sheet names and column names on each sheet are the same as of those in CONSOLIDATED WORKBOOK).
i)First sheet called product, second sheet channels and the last sheet is called Sales.

 

[Alex Blakenburg]

Give this a try. It assumes that in the consolidation sheet you have already formatted the date columns.

    Dim wb As String, i As Long, sh As Worksheet
    Dim srcRng As Range, srcArr As Variant
    Dim destRng As Range, destArr()
    Dim isrc As Long, idest As Long, icol As Long
    Dim lngDate As Long

    Application.ScreenUpdating = False
    wb = Dir(ThisWorkbook.Path & "\*")
    
    lngDate = CLng(Date)
    
    Do Until wb = ""
        If wb <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\" & wb
                For Each sh In Workbooks(wb).Worksheets
                        With sh.UsedRange
                            Set srcRng = .Offset(1).Resize(.Rows.Count - 1)           '<---- Assumes 1 header row
                            srcArr = srcRng.Value2
                        End With

                        ReDim destArr(1 To UBound(srcArr, 1), 1 To UBound(srcArr, 2))
                        idest = 0
                        For isrc = 1 To UBound(srcArr)
                            If CLng(srcArr(isrc, 1)) = lngDate Then
                                idest = idest + 1
                                For icol = 1 To UBound(srcArr, 2)
                                    destArr(idest, icol) = srcArr(isrc, icol)
                                Next icol
                            End If
                        Next isrc
                        
                        Set destRng = ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1)
                        Set destRng = destRng.Resize(idest, UBound(destArr, 2))
                        destRng = destArr
                
                Next sh
            Workbooks(wb).Close False
        End If
        wb = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[MoonLove]

Dear Alex,

Thanks a lot. The above code has managed to copy data which have todays date from source workbooks - worksheets to consolidated workbook worksheets. However, I have noticed one issue, if it happens no data of todays date has been captured in any sheet of any of the four source workbook , I get a run time error 1004.

To clarify further, these source workbooks (GK, SK, RJ and TB) are used by four different people to capture their day to day activities. But some of these people might be on leave sometime so they wont update anything on their workbook meaning the workbook wont have the data with current date.

Since the code is taking all data as of today date, then it will prompt a run time error 1004 due to one workbook missing the data as of todays date.

Kindly assist with how to avoid such errors.

Thank you a lot for your sincerely support.

 

[Alex Blakenburg]

Edited. Change this

                       ' Wrap the output statements in an If statement like this
                        If idest <> 0 Then
                            Set destRng = ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1)
                            Set destRng = destRng.Resize(idest, UBound(destArr, 2))
                            destRng = destArr
                        End If            
                Next sh

 

[MoonLove]

Thank you so so much for your help.

The code has work as how I wanted it to work.

Welcome in Tanzania.

In Swahili we say, "Karibu Tanzania".