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