Split worksheets

**mattmac** · 07-01-2009, 06:24 AM

Hi Guys,
Need a bit of help please:
In column A of a spread sheet I have lots of entries in this format:

admin_staff_a_002
admin_staff_a_006
admin_staff_1_010
admin_staff_1_003
admin_staff_b_005
admin_staff_z_007
admin_staff_z_001

What I need to achieve is to have a different worksheet containing all the rows for admin_staff_a then another for admin_staff_1 etc.

I want to name each of the worksheets a, 1 etc so i'd remove the admin_staff bit and the _003 bit

Not sure if I'm being clear enough but its hard to describe!

Thanks

**ravishankar** · 07-01-2009, 08:56 AM

Hi
List the names in col A and click the button to run the macro. It creates sheets with names from row 2 to last row
ravi

**StephenR** · 07-01-2009, 09:21 AM

This makes a number of assumptions: (1) your data are in A1 down but you have a header in A1 (can be anything) (2) your entries are all the same format "admin_staff_" followed by 1 character followed by "_" followed by three characters (3) column B in your original sheet is clear.

Code:

Sub Macro2()
 
Dim rng As Range, rng2 As Range, ws As Worksheet
 
Application.DisplayAlerts = False

With Sheet1
    Sheets.Add().Name = "Temp"
    With .Range("A1", .Range("A1").End(xlDown)).Offset(, 1)
        .Formula = "=LEFT(A1,13)"
        .Value = .Value
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True
    End With
    Set rng = Sheets("Temp").Range("A2", Sheets("Temp").Range("A2").End(xlDown))
    For Each rng2 In rng
        .Range("A1").AutoFilter field:=2, Criteria1:=rng2
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        .AutoFilter.Range.Copy ws.Range("A1")
        ws.Name = Mid(rng2, 13, Len(rng2) - 12)
    Next rng2
    .Columns(2).Delete
    Sheets("Temp").Delete
    .AutoFilterMode = False
End With
 
Application.DisplayAlerts = True
    
End Sub