VBA Code to consolidate and add multiple workbooks data

[Sameer Lal]

Hi Guys,

This forum has helped me a lot in my day to day excel problems but now i am stuck in a very urgent requirement from my management's side. We have created an excel workbook template with multiple worksheets. We do send this workbook to all our vendors in different location and they fill that up (every worksheet, highlighted cells) and send it back to us on daily basis. We save these workbooks into different folders region wise. Around 20-30 files in each folder.
Now i want to a VBA code to consolidate these workbooks for each region i.e. each workbbok's worksheets in each folder in to the Master Workbook (Which is also the same template) in such a way that it will pick up data from concerned cells from similar worksheets and add them up in mastersheet in the same cells.

Master Workbook and few dummy workbooks attached for reference.

Any help on the same will be really appreciated.

Thanks Guys...

 

[Deepak]

Pls share sheet wise cells which needs to capture ...

 

[Deepak]

Pls share sheet wise cells which needs to capture ...

OR. Are you looking to copy each sheet of each wb to master wb?

 

[Sameer Lal]

Hi Deepak,

The cells which i need to capture and add up in master workbook are already highlighted in the source workbooks in each worksheet.

So ultimately i want to copy each worksheet of each wb to master wb.

Thanks.

 

[Deepak]

Top most folder is static or dynamic ? Will you select it manually!!

 

[Sameer Lal]

No its always static.

 

[Deepak]

No its always static.

Ok. Stay tuned !!!

 

[Sameer Lal]

Sure,

Thanks..

 

[Deepak]

Hi,

You might feel slowness if there would be wb in .xls format

Set a reference to Microsoft Scripting Runtime by using
Tools > References in the Visual Basic Editor (Alt+F11)

Sub copy_ws()
Dim objFSO As New Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim objSubFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim strTopFolderName As String
Dim myWB As Workbook, copyWB As Workbook, ws As Worksheet

'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)
   
Application.ScreenUpdating = False

'top most folder
strTopFolderName = "D:\RunSheet" 'Change as yours

Set objTopFolder = objFSO.GetFolder(strTopFolderName)
Set myWB = ThisWorkbook

'start loop in top most folder
For Each objFile In objTopFolder.Files
    Set owbk = Workbooks.Open(objFile, UpdateLinks:=False)
        'start loop in open wb
        For Each ws In owbk.Worksheets
            ws.Copy after:=myWB.Sheets(myWB.Worksheets.Count)
        Next
    'close the wb
    owbk.Close False
Next
   
'start loop in SubFolders
Set objFile = Nothing
For Each objSubFolder In objTopFolder.SubFolders
    For Each objFile In objSubFolder.Files
        Set owbk = Workbooks.Open(objFile, UpdateLinks:=False)
        'start loop in open wb
        For Each ws In owbk.Worksheets
            ws.Copy after:=myWB.Sheets(myWB.Worksheets.Count)
        Next
    'close the wb
        owbk.Close False
    Next
Next

Set myWB = Nothing
Set objTopFolder = Nothing
Application.ScreenUpdating = True

 MsgBox "Done!", vbInformation, "Done"
End Sub

 

[Sameer Lal]

Thanks for this great help and you have created an outstanding code but i am sorry, i think i couldn't able to explain you my problem properly

Sorry for wasting your time Deepak.

Let me try to explain you this once more.

E.g. What the code should do is, it will pick up values from the highlighted cells e.g. cell "B17" from sheet e.g. "BP" from each of the workbooks i.e. "DBP - 2015_ABCD" & "DBP - 2015_QWERTY" and sum it up in the master workbook in sheet "BP" in cell "B17".

Now the above example is for only one cell but i want to do this for all the highlighted cells.

Hope this time i tried to explain myself correctly.

Thanks.

 

[Deepak]

Would you pls share the summary sheet like as below as i am still confused which range to get from sheets.