[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now


Split groups into new worksheets in one workbook

Posted on 2011-05-04
Medium Priority
Last Modified: 2012-05-11
I have a workbook that has the a grouping column "group" it has a value of either 5, 6, 7, 12, 13 ,14. (see attached)

I would like a way to separate the groups into their own worksheets within the workbook.

Macro? Formula? Annotation is always appreciated.

Question by:justearth
  • 2
  • 2
LVL 39

Accepted Solution

nutsch earned 2000 total points
ID: 35694741
Hi JE,

The attached macro should do just that.

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

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 = "Data " & cUnique(i)
    rgSel.CurrentRegion.Copy shtDest.Cells(1, 1)

shtData.AutoFilterMode = False

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

Open in new window


Author Comment

ID: 35694763

Author Closing Comment

ID: 35694764
LVL 39

Expert Comment

ID: 35694769
Glad to help

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

873 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question