Split worksheets into new workbooks, then split sheets by group

Hello,

This macro from the related question splits groups into worksheets:
Sub SplitListIntoWorksheets()
'split list into individual worksheets
Dim lastROw As Long, i As Long
Dim shtData As Worksheet, lgCol As Long, rgSel As Range
Dim cUnique As New Collection, shtDest As Worksheet
Const blTitles As Boolean = True                    'true if the data has titles, false otherwise
Const sColumn As String = "A"                       'Which column should the list be split on

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

lgCol = Cells(1, sColumn).Column
Set rgSel = Cells(1, 1).CurrentRegion

lastROw = Cells(Rows.Count, lgCol).End(xlUp).Row 'get last row

Set shtData = ActiveSheet

'load the column contents in a collection, to keep individual values
On Error Resume Next

For i = 2 To lastROw
    If Cells(i, lgCol) <> Cells(i - 1, lgCol) Then
        cUnique.Add Cells(i, lgCol), CStr(Cells(i, lgCol))
    End If
Next

On Error GoTo 0

'for each individual value, filter the list, copy the results to a new workbook, save and close the new workbook
For i = 1 To cUnique.Count
    shtData.AutoFilterMode = False
    rgSel.CurrentRegion.AutoFilter Field:=lgCol - rgSel.CurrentRegion.Column + 1, Criteria1:=cUnique(i)
    Set shtDest = Sheets.Add
    shtDest.Name = "Group " & cUnique(i)
    rgSel.CurrentRegion.Copy shtDest.Cells(1, 1)
Next

shtData.AutoFilterMode = False

Application.ScreenUpdating = True 'reenable ScreenUpdating
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub

Open in new window


I would like to know if there a macro that can first split a workbook with several sheets into a new workbook for each worksheet and then split those worksheets by group.

Annotation is always appreciated.

Thank you kindly,
JE
justearthAsked:
Who is Participating?
 
nutschConnect With a Mentor Commented:
You should be able to run my previous macro with the top one, as in :

Sub SplitInWorkbooks()
Dim sht As Worksheet, wbkDest As Workbook, wbkOrg As Workbook
Const strPath As String = "C:\Temp\SplitFiles\"

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set wbkOrg = ActiveWorkbook

For Each sht In wbkOrg.Sheets

    sht.Copy
    Set wbkDest = ActiveWorkbook
    
    Call SplitListIntoWorksheets
    
    wbkDest.SaveAs Filename:=strPath & sht.Name & ".xls", FileFormat:=xlExcel8
    wbkDest.Close True
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub


Sub SplitListIntoWorksheets()
'split list into individual worksheets
Dim lLoop As Long, arrData As Variant
Dim shtData As Worksheet, lgCol As Long, rgSel As Range
Dim cUnique As New Collection, shtDest As Worksheet
Const blTitles As Boolean = True                    'true if the data has titles, false otherwise
Const sColumn As String = "A"                       'Which column should the list be split on

lgCol = Cells(1, sColumn).Column
Set rgSel = Cells(1, 1).CurrentRegion

Set shtData = ActiveSheet

With shtData
    'load the column into an array for faster processing
    arrData = .Range(.Cells(1, sColumn), .Cells(.Rows.Count, sColumn).End(xlUp)).Value
    
    'load the array content in a collection, to keep individual values only
    On Error Resume Next
    
    For lLoop = LBound(arrData, 1) To UBound(arrData, 1)
        cUnique.Add arrData(lLoop, 1), CStr(arrData(lLoop, 1))
    Next
    
    On Error GoTo 0
    
    'for each individual value, filter the list, copy the results to a new worksheet
    For lLoop = 1 To cUnique.Count
        .AutoFilterMode = False
        rgSel.CurrentRegion.AutoFilter Field:=lgCol - rgSel.CurrentRegion.Column + 1, Criteria1:=cUnique(lLoop)
        Set shtDest = Sheets.Add
        shtDest.Name = "Data " & cUnique(lLoop)
        rgSel.CurrentRegion.Copy shtDest.Cells(1, 1)
    Next
    
    .AutoFilterMode = False
End With

End Sub

Open in new window


Thomas
0
 
Juan OcasioApplication DeveloperCommented:
Do you have an example?
0
 
justearthAuthor Commented:
I sure do. Whoops, I forgot to include it.

Thanks,
JE
je-split-groups-into-worksheets.xlsx
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Juan OcasioConnect With a Mentor Application DeveloperCommented:
OK so to make sure I understand:

You have several worksheets in a workbook.  You want to separate each woksheet into it's own workbook, the separate out the groups into separate sheets in each of the workbooks.  Correct?

If so, question:  In the initial workbook (your source wb), does each sheet have a separate set of groups?  In other words sheet 1 has groups 1-5, sheet 2 has 6-10, etc.
0
 
justearthAuthor Commented:
You have several worksheets in a workbook.  You want to separate each woksheet into it's own workbook, the separate out the groups into separate sheets in each of the workbooks.  Correct?

Yes, correct.


If so, question:  In the initial workbook (your source wb), does each sheet have a separate set of groups?  In other words sheet 1 has groups 1-5, sheet 2 has 6-10, etc.

Each worksheet has the same groups (the number of entries per groups vary). The groups are:
5, 6, 7, 12, 13, 14

Thanks for the help,
JE
0
 
Juan OcasioApplication DeveloperCommented:
Ok so it doesn't matter that a group is in each worksheet.  They're all separate from each other.

Got it
0
 
justearthAuthor Commented:
Thomas,
When I run this, its not splitting the worksheets into workbooks? Ideas?
0
 
nutschCommented:
Do you run splitinworkbooks? What happens?

Do you have a folder C:\Temp\SplitFiles\

0
 
justearthAuthor Commented:
I was just running it from the macro editor. Then it only ran the "Sub SplitListIntoWorksheets()".

It will split them if I run the macros separately. The script you provided above requires that you first split into workbooks and then go to each new work book and run "Sub SplitListIntoWorksheets()", correct? I was hoping that the macro would remove that step and would:

I would like to know if there a macro that can first split a workbook with several sheets into a new workbook for each worksheet and then split those worksheets by group

Thanks again,
Cheers,
JE
0
 
justearthAuthor Commented:
Never mind. It works.

Cheers,
Thanks,
JE
0
 
justearthAuthor Commented:
Thanks again. Excuse my confusion.

Cheers,
JE
0
 
Juan OcasioApplication DeveloperCommented:
Hey JE:

Thanks for the points.  Not really sure I deserved them as I wasn't a real contributor to your solution.  If they can be reassigned, should probably all go to nutsch.  

If not, thanks again!!!
0
 
nutschCommented:
Thanks for the grade.

No problem jocasio123, the questions you asked helped me get it right the first time.

T
0
 
justearthAuthor Commented:
nutsch & jocasio123,
Thanks,
Yeah, I thought jocasio123's questions allowed me to clarify my problem. nutsch, thanks for another great solution.

Cheers,
JE
0
 
Juan OcasioApplication DeveloperCommented:
Well thanks guys!  great team work :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.