I thought I posted this hours earlier today but it never showed up???
Anyway, I have one column of data with Depts and Names listed below the
dept. I need to printout one sheet for each dept and associated names.
Remember this is in one column:

Finance
Bob...
Julie...
(18 more names)
Marketing
Joe...
Fred...
Mary...
(9 more names)
Legal
bob...
Henry...
Manufacturing
(140 names)
many more departments with different numbers of names below each one.
thx

Hi,

Right click your sheet tab, view code and paste the code below in. Add to
the list of departmenst as required. It will put eqach department and names
in a seperate column

Sub NextSheet()
Dim R As Range
Dim V As Variant
Dim S As String
Dim MyColumn As Long
MyColumn = 1
x = 1
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Add as required
S = "Finance,Marketing,Legal,Manufacturing"
V = Split(S, ",")
For Each c In Range("A1:A" & lastrow)

If Not IsError(Application.Match(CStr(c.Value), V, 0)) Then
MyColumn = MyColumn + 1
x = 1
Cells(x, MyColumn).Value = c.Value
Else
x = x + 1
Cells(x, MyColumn).Value = c.Value

End If
Next

End Sub

Mike

"Maarkr" wrote:

I thought I posted this hours earlier today but it never showed up???
Anyway, I have one column of data with Depts and Names listed below the
dept. I need to printout one sheet for each dept and associated names.
Remember this is in one column:

Finance
Bob...
Julie...
(18 more names)
Marketing
Joe...
Fred...
Mary...
(9 more names)
Legal
bob...
Henry...
Manufacturing
(140 names)
many more departments with different numbers of names below each one.
thx

I should have been more specific.. the actual dept names are like "32245***
Fin Dept Anytown USA 00000 ***", with 'Dept' being the common imbedded text
that I can filter for the different dept's, so I need to use like a "*Dept*"
to breakout the depts where you have S =
"Finance,Marketing,Legal,Manufacturing"? I tried "*Dept*" but the syntax is
wrong.

"Mike H" wrote:

Hi,

Right click your sheet tab, view code and paste the code below in. Add to
the list of departmenst as required. It will put eqach department and names
in a seperate column

Sub NextSheet()
Dim R As Range
Dim V As Variant
Dim S As String
Dim MyColumn As Long
MyColumn = 1
x = 1
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Add as required
S = "Finance,Marketing,Legal,Manufacturing"
V = Split(S, ",")
For Each c In Range("A1:A" & lastrow)

If Not IsError(Application.Match(CStr(c.Value), V, 0)) Then
MyColumn = MyColumn + 1
x = 1
Cells(x, MyColumn).Value = c.Value
Else
x = x + 1
Cells(x, MyColumn).Value = c.Value

End If
Next

End Sub

Mike

"Maarkr" wrote:

I thought I posted this hours earlier today but it never showed up???
Anyway, I have one column of data with Depts and Names listed below the
dept. I need to printout one sheet for each dept and associated names.
Remember this is in one column:

Finance
Bob...
Julie...
(18 more names)
Marketing
Joe...
Fred...
Mary...
(9 more names)
Legal
bob...
Henry...
Manufacturing
(140 names)
many more departments with different numbers of names below each one.
thx