Data Consolidation from many Workbooks to One Workbook

[Rashid Khan]

Hello All,
I am using Office XP and I wish to extract data from many workbooks in the
directory C:\Temp to a new Workbook and save it under a new name:

The data are in rows for eg (Name can be anything... *.xls)

Workbook1.xls, (Sheets 1, 2, .... )
(Workbook2.xls.....(Sheets 1, 2,3,4 .... )
and many more Workbooks all in C:\Temp

The new Workbook should have all the data from the above Workbooks copied on
Sheet1, Column A down.

Can this be achieved?

TIA
Rashid Khan

 

[Bernie Deitrick]

Rashid,

See the sub below. This version puts labels into the first two columns to
show the book and sheet from whence they came: if you don't like the labels,
simply delete the first two columns after you're done.

HTH,
Bernie
MS Excel MVP

Sub Consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A

With Application
..DisplayAlerts = False
..EnableEvents = False
..ScreenUpdating = False
End With

With Application.FileSearch
..NewSearch
'Change this to your directory
..LookIn = "C:\Temp"
..FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).Offset(1, 0)
With Basebook.Worksheets(1)
..Range(.Range("A65536").End(xlUp).Offset(1, 0), _
..Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
..Range(.Range("B65536").End(xlUp).Offset(1, 0), _
..Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With

With Application
..DisplayAlerts = True
..EnableEvents = True
..ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename


End Sub

 

[Ron de Bruin]

Start here Rashid
http://www.rondebruin.nl/copy3.htm

 

[Rashid Khan]

Hi Bernie,
After running your code. I got the following results:
MyBook.xls Sheet1 MyBook.xls Sheet1
MyBook.xls Sheet2 MyBook.xls Sheet1
MyBook.xls Sheet3 MyBook.xls Sheet1
MyBook.xls Sheet3 MyBook.xls Sheet1 MyBook.xls Sheet1
MyBook.xls Sheet3 MyBook.xls Sheet2 MyBook.xls Sheet1


What I mean.. I did not get any values but instead I am getting the FileName
and the SheetName

What can be the problem?
Rashid

 

[Rashid Khan]

Hi Ron,
Thanks for the reply.. I found many things interesting over there. I would
give it a try and post back if there is any problems

Rashid

 

[Ron de Bruin]

Try to understand the examples

For you situation you must loop through all your sheets in each workbook and copy
the usedrange from each sheet.
Remember you have only 65536 rows and the usedrange can be bigger then your data.
http://www.contextures.com/xlfaqApp.html#Unused

If you need help post back

 

[Bernie Deitrick]

Rashid,

The code is written based on finding the data table starting in A1, and
being contiguous. That apparently isn't the case, so the code need to be
modified: change the A1 in the line

Range("A1").CurrentRegion.Copy

to any cell that will always be in your data table.

HTH,
Bernie
MS Excel MVP

 

[Rashid Khan]

Hi Bernie,
Yes u are right the data starts from A2. But after changing the line
Range("A2").CurrentRegion.Copy... the macro still gives the file name and
the sheet name as I posted previously.

However I have got my problem solved by using the suggestion of Ron de
Bruin, I thougt I might just inform you about the problem with your code.

Thanks for all the help and time
Rashid Khan