Consolidation

R

Ray

hello,

I am trying to make a macro in order to consolidate several sheets in
several workbooks. Those sheets contains tables with numbers and string of
text. That is the reason why I could not use the consolodiation tools.
For example : from 3 classeurs containing several sheets...
- A.xls contains sheets A1, A2, A3,..
- B.xls contains sheets B1,B2
- C.xls contains sheets C1,C2,C3,C4,....
....I would like to obtain in the same sheet of a new workbook one table
consolidating all the content as below :

content of A1
content of A2
content of A3
content of ..
content of B1
content of B2
content of C1
content of C2
content of C3
content of C4
content of...
I have some pb to build this macro, any help will be really appreciated
Thanks in advance
 
B

Bernie Deitrick

Ray,

Try the sub below. Create a new workbook, put this macro into a codemodule in the workbook, then
save the workbook in the same folder with the other files. All files within that folder will be
consolidated. Assumes that all data starts in cell A1 and is contiguous, with no blanks in column
A

HTH,
Bernie
MS Excel MVP

Sub Consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet

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

With Application.FileSearch
..NewSearch
'Change this to your directory
'or save the workbook in the folder with the other files
..LookIn = ThisWorkbook.Path
..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
 
R

Ray

Thank you Bernie, I test it and come back
Ray


Bernie Deitrick said:
Ray,

Try the sub below. Create a new workbook, put this macro into a codemodule in the workbook, then
save the workbook in the same folder with the other files. All files within that folder will be
consolidated. Assumes that all data starts in cell A1 and is contiguous, with no blanks in column
A

HTH,
Bernie
MS Excel MVP

Sub Consolidate()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet

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

With Application.FileSearch
.NewSearch
'Change this to your directory
'or save the workbook in the folder with the other files
.LookIn = ThisWorkbook.Path
.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
 
R

Ray

Bonjour Bernie,

Thats is not only what I wanted, but more : great !
I will study your code because I do not see where it says, take the name of
the file and the sheet in order to write it with the content.
Thanks again that help me very much
Ray
 
Top