Macro to Consolidate multiple workbooks into new workbook based on criteria

[abraham30]

Hello !

Can anyone help me to collate multiple workbooks(>300) into a new workbook by filtering only data from the specified date mentioned in the sheet.

Path:-D:\US\EastHanover
Workbook name : SAMPLE-EH-US-WHO-20130102, SAMPLE-EH-US-WHO-20130103, SAMPLE-EH-US-WHO-20130109 etc..
New workbook name: SAMPLE-EH-Master
Columns to capture:-A, B, D (time should be truncated from the date)

Attached spreadsheet for your reference

[Aussiebear]

Questions, Questions, Questions????
Are all the workbooks in a single folder (Directory)?
All all the workbooks in a single sheet format, and if not will they all be on the same sheet?
Does the output need to be on one sheet, as in each new input to run from the last row of the previous input?
Are there any blanks in Column A?

[abraham30]

I apologize Aussie to trouble you. I am preparing one dashboard for which I need data from all sheet . I am not a macro expert like you.:banghead:
I search the code in online but not getting proper output.

Yes, all the workbooks are there in single folder EastHanover
->All the workbook possess same single sheet format and column A do not contain any blank column
-->Yes, I need the output in single sheet
I found macro which is working fine but I need to change sheet name everytime as all sheet name start with "SAMPLE-EH-US-WHO" followed by date like "20130102", 03, 04 etc.


Sub ConsolidateWB()
Dim vFileNames As Variant
Dim y As Long
Dim wbTemp As Workbook
Dim wbNew As Workbook
Dim blHeader As Boolean
Dim rng As Range

Application.ScreenUpdating = False
Set wbNew = Workbooks.Add
blHeader = False
vFileNames = Application.GetOpenFilename(Title:="Select all workbooks to copy", _
MultiSelect:=True)
'Will not be array if no file is selected
'If user selects one or more files, files will be stored as an array
If Not IsArray(vFileNames) Then GoTo ConsolidateWB_End
For y = LBound(vFileNames) To UBound(vFileNames)
'Open each wb selected
Set wbTemp = Workbooks.Open(vFileNames(y))
Set rng = wbTemp.Worksheets("SAMPLE-EH-US-WHO").Range("A1").CurrentRegion
'If header row already copied, then offset by 1 to exclude header
If blHeader Then
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
'If header row not already copied, keep rng as is and change blHeader to true
Else
blHeader = True
End If
'Paste to next row on new wb
rng.Copy Destination:=wbNew.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
wbTemp.Close SaveChanges:=False
Next y
ConsolidateWB_End:
Application.ScreenUpdating = True
End Sub

[Aussiebear]

have a look here at the RDB Merge addin from Ron DeBruin
http://www.rondebruin.nl/win/addins/rdbmerge.htm

It should work for you, and once the workbook is compiled simply delete the columns (C,E & F).

Then, to remove the time portion of the Date time string, simply highlight the column and format as Date