create sep sheets based on data in column

src68

New Member
Joined
Jul 21, 2011
Messages
14
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.
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try:

Code:
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
 

src68

New Member
Joined
Jul 21, 2011
Messages
14
Holly cr*p.. that worked like a charm....
thx.. saved me alot of cutting and pasting... i sure wish i knew a lot more about codes and macros....

again thanks.... heres to you...(y)
 

src68

New Member
Joined
Jul 21, 2011
Messages
14
can you tweek this a little. I only want th have the 1st row with all the heading info show up on all the sheets that get created....

so based on my exp. above... only "dept, emply #, dept name, blah, blah"
headers for Column a - e.

thanks...
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Sorry, I don't know what you mean. The macro is copying the headings isn't it?
 

src68

New Member
Joined
Jul 21, 2011
Messages
14
Sorry, I don't know what you mean. The macro is copying the headings isn't it?

yes but it is also copying all the rows for that group. to ea. sheet...
i just want the heading copied to ea. sheet i was wrong origianlly ... i thought i need the respective rows copied too... but i don't... or at least i don't think that will help me do what i need to do with the info....
thx
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
To copy just the header:

Code:
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
    For Each Item In List
        Set ShNew = Worksheets.Add
        ShNew.Name = Item
        Rng.Cells(1, 1).EntireRow.Copy ShNew.Range("A1")
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub
 

ESP1066

New Member
Joined
Jan 17, 2013
Messages
2
Hi,
I'm new to VBA.
Could someone tell me what Im doing wrong here.
Im trying to create and sort new sheets based on data in column D of my worksheet.
Using code above i kinda have it working.
It is creating a new sheet for each character listed in column D and is sorting them per sheet.
The problem is that the range of data I need is from column A to P
So far I can only get the code above only displays data from D to P.
Any help would be great.
Thanks to Mr. Excel VP for giving me something to start with ;)
Thanks.

Heres the code:

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
' *** The job that this program needs to do ***
' *** Set Sheet 1, Column D as the first place to look, creating a sheet for each character listed in column D ***
' *** There are 8 characters listed in column D, so 8 sheets will be created ***
' *** These sheets will be populated with the entries found in sheet 1 that have corresponding character in column D ***

Set Sh = Worksheets("Sheet1")
Set Rng = Sh.Range("D1:D" & Sh.Range("D65536").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

' *** This is where the problems start, for each entry in DB there is data stored from cells A to P
' *** Using the code below, Its works but I'm missing data from columns A to C
' *** If I set range to A1:P, it doesnt work and crashes, placing the same data in first row of each sheet
' *** How do I get data from columns A to C to display ?? (ie: All data from A to P) ***

Set Rng = Sh.Range("D1:P" & Sh.Range("D65536").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
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Welcome to MrExcel.

Try changing:

Rng.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")

to:

Rng.EntireRow.SpecialCells(xlCellTypeVisible).Copy ShNew.Range("A1")
 

Watch MrExcel Video

Forum statistics

Threads
1,096,356
Messages
5,449,943
Members
405,579
Latest member
life3970

This Week's Hot Topics

Top