Consolidate different sheets to different workbooks

[markx]

Hello everybody!
Could you help me pls on this:

In my particular exemple, I have like 34 workbooks (put together in the same
folder), every workbook having the same structure:
- 6 different tabs AA, BB, CC, DD, EE, FF
- in every workbook the tabs have the same name (i.e. in workbook 1 we have
worksheets AA, BB, CC, DD, EE, FF, in workbook 2 it's the same and so
on...). The only thing that changes is the name of the workbooks and, of
course, the content of the sheets.

I would like to consolidate this in such way, that I would receive at the
end 6 different workbooks, and every workbook would contain 34 worksheets of
the same family (i.e. name).
Ideally (but it's not necessary if too complicated) the names of the new
created files would be like those of the "initial" sheets (i.e. AA, BB, CC,
DD, EE, FF), and the sheets names in these new files would be like the names
of the "initial" files from which they were taken.

So, just to recapitulate: instead of having X workbooks with Y different
worksheets each (same pattern for every workbook), I would like to have Y
workbooks with X worksheets each.

Is this feasible? Do you know any macro capable of doing this?
Pls advise,

Regards,
Mark

 

[Bernie Deitrick]

Mark,

Try the macro below.

Put the 34 files into the same folder, with no other files, and then change
the path name in the line:

.LookIn = "C:\Excel\Combine Folder"

to that folder.

HTH,
Bernie
MS Excel MVP

Sub RecombineSheets()
Dim myBook As Workbook
Dim mySht As Worksheet
Dim bookName As String
Dim shtName As String
Dim i As Integer

Application.DisplayAlerts = False

With Application.FileSearch
.NewSearch
.LookIn = "C:\Excel\Combine Folder"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
Set myBook = Workbooks.Open(.FoundFiles(1))
shtName = Replace(myBook.Name, ".xls", "")
For Each mySht In myBook.Worksheets
bookName = mySht.Name
mySht.Name = shtName
mySht.Copy
ActiveWorkbook.SaveAs Filename:= _
.LookIn & "\" & bookName & ".xls", _
FileFormat:=xlNormal
mySht.Name = bookName
Next mySht
myBook.Close False

For i = 2 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
shtName = Replace(myBook.Name, ".xls", "")
For Each mySht In myBook.Worksheets
bookName = mySht.Name
mySht.Name = shtName
mySht.Copy Before:=Workbooks(bookName & ".xls").Sheets(1)
Workbooks(bookName & ".xls").Save
mySht.Name = bookName
Next mySht
myBook.Close False
Next i
End If
End With

Application.DisplayAlerts = True

End Sub

 

[markx]

Thanks Bernie,
It's more than perfect!
Mark

Mark,

Try the macro below.

Put the 34 files into the same folder, with no other files, and then
change
the path name in the line:

.LookIn = "C:\Excel\Combine Folder"

to that folder.

HTH,
Bernie
MS Excel MVP

Sub RecombineSheets()
Dim myBook As Workbook
Dim mySht As Worksheet
Dim bookName As String
Dim shtName As String
Dim i As Integer

Application.DisplayAlerts = False

With Application.FileSearch
.NewSearch
.LookIn = "C:\Excel\Combine Folder"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
Set myBook = Workbooks.Open(.FoundFiles(1))
shtName = Replace(myBook.Name, ".xls", "")
For Each mySht In myBook.Worksheets
bookName = mySht.Name
mySht.Name = shtName
mySht.Copy
ActiveWorkbook.SaveAs Filename:= _
.LookIn & "\" & bookName & ".xls", _
FileFormat:=xlNormal
mySht.Name = bookName
Next mySht
myBook.Close False

For i = 2 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
shtName = Replace(myBook.Name, ".xls", "")
For Each mySht In myBook.Worksheets
bookName = mySht.Name
mySht.Name = shtName
mySht.Copy Before:=Workbooks(bookName & ".xls").Sheets(1)
Workbooks(bookName & ".xls").Save
mySht.Name = bookName
Next mySht
myBook.Close False
Next i
End If
End With

Application.DisplayAlerts = True

End Sub

 

[Bernie Deitrick]

Mark,

It's more than perfect!

That's a first for me!

Thanks for letting me know that you're happy with the macro. We always
appreciate feedback - well, positive feedback, at least ;-)

Bernie
MS Excel MVP