Moving groups of worksheets into new workbooks based on worksheet names.

[PietC]

Good evening all. I was previously looking (see “Grouping sheets from multiple workbooks”) for a solution that took a folder full of single-sheet workbooks relating to team reports (eg “Team Alpha Q1”, “Team Bravo Q1”, “Team Alpha Q2”, “Team Bravo Q2”) and consolidating these into a number of Team-based workbooks (eg “Team Alpha” containing sheets Q1 and Q2; “Team Bravo” containing sheets Q1 and Q2 etc).

This hasn’t had any response so I’ve re-framed my approach in a new thread. I now have a single workbook with a great number of sheets relating to each team; these were originally in a random sequence but I have used VBA to sort the sheets alphabetically. The next thing I want to do is to take groups of sheets relating to the same team and move them to new workbooks as before, using the team names.

There are a couple of “gotchas” that I’m struggling with:

• I have successfully managed to move a pre-set number of sheets to a different workbook. This is usually OK as there are usually the same number of sheets for each team; however, this isn’t always the case so I’m trying to find a way of selecting all sheets that begin with the same team name.
• The second thing I'm struggling with is creating the new workbooks with the team names; not all team names have the same structure, thus I could have teams Alpha, Delta Uniform, Zulu etc. However, each team’s sheets starts with the full team name.

To summarize (sorry to be long-winded):

• I start with a single workbook containing 100 or so sheets named along the lines of: Alpha Q1; Alpha Q2; Delta Uniform Q1; Delta Uniform Q2; Zulu Q1; Zulu Q2 and Zulu Q3.
• I’d like to end up with Workbook “Alpha” containing sheets Q1 and Q2; “Delta Uniform” containing sheets Q2 and “Zulu” containing Q1, Q2 and Q3.

It doesn’t really matter if the final sheets also include the team name, although that makes them rather long!

Many thanks for your patience in reading this … and I hope someone might be able to point me in the right direction.
Piet

 

[JLGWhiz]

Good evening all. I was previously looking (see “Grouping sheets from multiple workbooks”) for a solution that took a folder full of single-sheet workbooks relating to team reports (eg “Team Alpha Q1”, “Team Bravo Q1”, “Team Alpha Q2”, “Team Bravo Q2”) and consolidating these into a number of Team-based workbooks (eg “Team Alpha” containing sheets Q1 and Q2; “Team Bravo” containing sheets Q1 and Q2 etc).

This hasn’t had any response so I’ve re-framed my approach in a new thread. I now have a single workbook with a great number of sheets relating to each team; these were originally in a random sequence but I have used VBA to sort the sheets alphabetically. The next thing I want to do is to take groups of sheets relating to the same team and move them to new workbooks as before, using the team names.

There are a couple of “gotchas” that I’m struggling with:

• I have successfully managed to move a pre-set number of sheets to a different workbook. This is usually OK as there are usually the same number of sheets for each team; however, this isn’t always the case so I’m trying to find a way of selecting all sheets that begin with the same team name.
• The second thing I'm struggling with is creating the new workbooks with the team names; not all team names have the same structure, thus I could have teams Alpha, Delta Uniform, Zulu etc. However, each team’s sheets starts with the full team name.

To summarize (sorry to be long-winded):

• I start with a single workbook containing 100 or so sheets named along the lines of: Alpha Q1; Alpha Q2; Delta Uniform Q1; Delta Uniform Q2; Zulu Q1; Zulu Q2 and Zulu Q3.
• I’d like to end up with Workbook “Alpha” containing sheets Q1 and Q2; “Delta Uniform” containing sheets Q2 and “Zulu” containing Q1, Q2 and Q3.

It doesn’t really matter if the final sheets also include the team name, although that makes them rather long!

Many thanks for your patience in reading this … and I hope someone might be able to point me in the right direction.
Piet

If you have a series of sheet names which begin with "Alpha" then you could use a wild card asterisk to return the sheet, like

For Each sh in ThisWorkbook.Sheets
	If sh.Name Like "Alpha*" Then
		'do something
	End If
Next

When you want to create the workbook and name it with the full sheet name, use the sheet name as the workbook name and add the file extension.

Workbooks.Add
ThisWorkbook.Sheets("Alpha Q1").Copy Before:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.SaveAs ActiveWorkbook.Sheets(1).Name & ".xlsx"  'If path is different than default path, it will need to be inserted in front of the wb name.

 

[PietC]

Hi JLGWhiz - thanks for such a swift reply - much appreciated.

The first suggestion is great; I suppose that I could manually populate a range with the team names in advance and then step through these, adding the wild card to get all variants of the related sheet names.

I see what you mean about creating the new workbook, though I'm not sure it does exactly what I need. Picking up on the point above, I think I should be able to create the workbook when I step through the team names in the range, and then create a loop to add each worksheet that matches the "like" criterion.

Being picky, it would be nice to be able to strip out the team name from the final sheet names to save space ... but I think I'll walk before I run! Thanks again.

Plenty more for me to think about - thanks for getting me started.

 

[sericom]

Give this a try:

Application.ScreenUpdating = False
Dim mainWb As Workbook
Dim newWB As Workbook
Dim ws As Worksheet
Dim currName As String
Dim wsName As String
Set mainWb = ActiveWorkbook
Workbooks.Add
Set newWB = ActiveWorkbook
currName = Left(mainWb.Worksheets(1).name, InStrRev(mainWb.Worksheets(1).name, " ") - 1)
For Each ws In mainWb.Worksheets
    wsName = Left(ws.name, InStrRev(ws.name, " ") - 1)
    If wsName <> currName Then
        newWB.SaveAs Filename:=currName, FileFormat:=xlOpenXMLWorkbook
        newWB.Close
        Workbooks.Add
        Set newWB = ActiveWorkbook
    End If
    ws.Copy after:=newWB.Sheets(newWB.Sheets.Count)
    newWB.Sheets(ws.name).name = Right(ws.name, Len(ws.name) - InStrRev(ws.name, " "))
currName = Left(ws.name, InStrRev(ws.name, " ") - 1)
Next
newWB.SaveAs Filename:=currName, FileFormat:=xlOpenXMLWorkbook
newWB.Close
Application.ScreenUpdating = True

 

[JLGWhiz]

Hi JLGWhiz - thanks for such a swift reply - much appreciated.

The first suggestion is great; I suppose that I could manually populate a range with the team names in advance and then step through these, adding the wild card to get all variants of the related sheet names.

I see what you mean about creating the new workbook, though I'm not sure it does exactly what I need. Picking up on the point above, I think I should be able to create the workbook when I step through the team names in the range, and then create a loop to add each worksheet that matches the "like" criterion.

Being picky, it would be nice to be able to strip out the team name from the final sheet names to save space ... but I think I'll walk before I run! Thanks again.

Plenty more for me to think about - thanks for getting me started.

Those were just examples of 'how to' without a lot of detail. Personally, I try to set up my projects so I can capture workbooks and sheets in variables so that I only have to deal with them one time. Then I use the varibles throughout the code to save space and effort in building the code. It took me several years to learn a lot of the time and space saving methods, and I am still learning. Rick Rothstein is a real maven with the condensed code and I pick up a lot from him, but some of it I have not yet grasped for practical use in my personal files. Still learning as I go.
Regards, JLG

 

[PietC]

Thanks JLGWhiz and Sericom for your help, which is really useful. I agree with JLGWhiz that this may be a case of "if I were going there I wouldn't start from here!" but I didn't have much choice in this case. The project is for some voluntary work I'm doing; I'm about to go to work for the day job and shall check this further when I return home. Many thanks again. As ever, Piet

 

[PietC]

Well - I'm really glad that I changed my approach to the problem and started this thread. Thanks again to you both; Sericom's sample code was an absolute masterpiece and just what I needed. I still have a lot to do but this has really helped ... and I've learned a lot about InStrRev as well, which will be very useful.

What a great forum! Piet