Create multiple worksheets
 

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)

Create multiple worksheets
 

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

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"John" wrote in message ...
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)

Create multiple worksheets
 

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

Create multiple worksheets
 

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!


On Jul 30, 5:39*pm, GTVT06 wrote:
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

Create multiple worksheets
 

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




On Jul 30, 5:58*pm, wrote:
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!

On Jul 30, 5:39*pm, GTVT06 wrote:

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

Create multiple worksheets
 

On Jul 30, 4:58*pm, wrote:
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!

On Jul 30, 5:39*pm, GTVT06 wrote:



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- Hide quoted text -

- Show quoted text -

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

Create multiple worksheets
 

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

On Jul 30, 7:59*pm, GTVT06 wrote:
On Jul 30, 4:58*pm, wrote:



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!

On Jul 30, 5:39*pm, GTVT06 wrote:

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- Hide quoted text -

- Show quoted text -

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

Create multiple worksheets
 

Thanks Ron...this worked perfectly!

"Ron de Bruin" wrote:

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

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"John" wrote in message ...
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)