Create multiple worksheets

[John]

Looking for some help creating a macro that will sort through a list and
create a worksheet for each entry in a column. The data lists about 30-40
names mutiple times in several hundred entries. I need to create a new
worksheet titled with that persons name.

Thanks in advance! (Using Excel 2003)

 

[Ron de Bruin]

Start here John
http://www.rondebruin.nl/copy5.htm

 

[GTVT06]

Hello, this will do it if you data is in column A

Sub sheets()
Dim LRow As Long
LRow = ActiveSheet.Range("A65536").End(xlUp).Row
Dim cell As Range
For Each cell In Range("A1:A" & LRow)
If cell.Value > "" Then
Worksheets.Add().Name = cell.Value
End If
Next cell
End Sub

 

[sbitaxi]

GTVT06 - won't that create a new worksheet for every cell in column A,
even if it a worksheet has been created for that value? He could end
up with thousands!

 

[sbitaxi]

Sub Sheets()
Dim Rng as Range
Dim WS1 as Worksheet
Dim WS2 as Worksheet
Dim LRow As Long


Set WS1 = ActiveSheet
Set WS2 = Worksheets.Add
Set Rng = WS1.Range("A1:YOUR LAST COLUMN OF DATA" & Rows.Count)

' Creates list of unique values
With WS2
Rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

' Creates worksheets from unique values
LRow = WS2.Range("A65536").End(xlUp).Row
Dim cell As Range
For Each cell In Range("A1:A" & LRow)
If cell.Value > "" Then
Worksheets.Add().Name = cell.Value
End If
Next cell
End Sub

 

[GTVT06]

GTVT06 - won't that create a new worksheet for every cell in column A,
even if it a worksheet has been created for that value? He could end
up with thousands!




- Show quoted text -

your right, I forgot he said he would have them listed multiple times,
I wrote that expecting there were no duplicates.

 

[sbitaxi]

No problem, I borrowed your code to finish it, however I forgot to
delete the filter sheet.

John, if you're still looking, add this line at the end

WS2.Delete

 

[John]

Thanks Ron...this worked perfectly!

Start here John
http://www.rondebruin.nl/copy5.htm