create sep sheets based on data in column

[src68]

Hello,

I am trying to figure out how i can create sep sheets in a workbook based on data on sheet 1 column A... along with the header info in row 1 of sheet 1 and all the respective rows for that sheet.. Any help would be great... ie data sample

dept emply # dept name blah blah
1221 1023 xxx xxx xxx
1221 1023 xxx xxx xxx
991 451 xx xxx xxx
10451 6533 xxx xxx xxx

so then this would create 3 differ sheets based on Dept. column and then also copy the header row... ea. sheet would be named on Column A data also.

 

[ESP1066]

Thank you Andrew, that worked perfectly!

 

[naveenBapu]

Hello Andrew Thanks for your code and I am using the first one
Is there any way we can copy headers (say row to 10) from the main sheet into all the successive tabs that are created along with the formatting in the main sheet?

any help would be sincerely appreciated

 

[Andrew Poulsom]

Welcome to MrExcel.

Does this work for you?

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim ShNew As Worksheet
    Application.ScreenUpdating = False
'   *** Change Sheet name to suit ***
    Set Sh = Worksheets("Sheet1")
    Set Rng = Sh.Range("A11:A" & Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row)
    On Error Resume Next
    For Each c In Rng
        List.Add c.Value, CStr(c.Value)
    Next c
    On Error GoTo 0
    Set Rng = Sh.Range("A10:E" & Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row)
    For Each Item In List
        Set ShNew = Worksheets.Add
        ShNew.Name = Item
        Rng.AutoFilter Field:=1, Criteria1:=Item
        Rng.EntireColumn.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
        Rng.AutoFilter
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub

 

[naveenBapu]

Hey Andrew,
thanks for the swift response, not sure if I am doing something wrong here but the code throws an execution error while i try to run it.
Just to reiterate, we want row 1 to 10 into every tab thats created and row 11 onwards we have the data and ColA is the col in scope which has the values to be split. If copied with the formatting from the main sheet that will be great as well

Many thanks

 

[Andrew Poulsom]

What error do you get and on which line?

 

[mookiesaurus]

Hi Andrew! I'm new to VBA and would really appreciate your help! I was tinkering with the code but was unable to produce what I am looking to do. I have an Excel data dump that yields the following format across 20k lines:

123 - dept 1

header header2 header 3 etc
line 1
line 2
line 3
etc.

293 - dept 2

header header2 header 3 etc
line 1
line 2
etc.

Each dept has the same # of columns but a different # of rows and a couple rows between each for formatting. If it helps, each dept starts with a # and are the only rows that do so (all other rows start with letters). I am trying to have each dept broken out into a separate tab within the same workbook with the dept (i.e. "123 - dept 1") as the sheet name and formatting copied over. Anyway this is possible?

 

[Dunkthefunk]

Hello all,

Thank you very much for your insight Andrew!

I am looking to instead of split out not by worksheet but to new workbooks? Furthermore I have pivots and formulas that link into the master sheet (data sheet), I am looking for the other tabs that link into the data sheet could copied and moved across into the new workbooks and linked into the new split out data sheet.

In summary, I am hoping to split data out into work books with all the other pivots to linking in.

Any help on this is greatly appreciated!

 

[jamescooper]

Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim c As Range
Dim List As New Collection
Dim Item As Variant
Dim ShNew As Worksheet
Application.ScreenUpdating = False
' *** Change Sheet name to suit ***
Set Sh = Worksheets("Sheet1")
Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
On Error Resume Next
For Each c In Rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = Sh.Range("A1:E" & Sh.Range("A65536").End(xlUp).Row)
For Each Item In List
Set ShNew = Worksheets.Add
ShNew.Name = Item
Rng.AutoFilter Field:=1, Criteria1:=Item
Rng.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
Rng.AutoFilter
Next Item
Sh.Activate
Application.ScreenUpdating = True
End Sub


With this code how do you alter it so that the tabs are generated in alphabetical order? Thanks.

 

[jamescooper]

Sub Test()

Dim Sh As Worksheet
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim ShNew As Worksheet
    Application.ScreenUpdating = False
'   *** Change Sheet name to suit ***
    Set Sh = Worksheets("Sheet1")
    Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
    On Error Resume Next
    For Each c In Rng
        List.Add c.Value, CStr(c.Value)
    Next c
    On Error GoTo 0
    Set Rng = Sh.Range("A1:E" & Sh.Range("A65536").End(xlUp).Row)
    For Each Item In List
        Set ShNew = Worksheets.Add
        ShNew.Name = Item
        Rng.AutoFilter Field:=1, Criteria1:=Item
        Rng.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
        Rng.AutoFilter
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub

With this code how do you alter it so that the tabs are generated in alphabetical order? Thanks.

Can anyone help with this please, I think it is only a small change.