Data Consolidation from many Workbooks to One Workbook
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" wrote in message
...
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
"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
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).O ffset(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
"Rashid Khan" wrote in message
...
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
|