• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 490
  • Last Modified:

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
0
justearth
Asked:
justearth
  • 7
  • 5
  • 3
2 Solutions
 
Juan OcasioCommented:
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
 
Juan OcasioCommented:
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
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 OcasioCommented:
Ok so it doesn't matter that a group is in each worksheet.  They're all separate from each other.

Got it
0
 
nutschCommented:
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
 
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 OcasioCommented:
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 OcasioCommented:
Well thanks guys!  great team work :)
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 7
  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now