Glad it worked for you. If it was indeed helpful, please click the 'yes'
button to indicate such.

Ryan---

--
RyGuy


"CJ" wrote:

Thanks RyGuy...

I had to modify it a tad... I was getting a circular reference
error...

Here is what works for me:

Sub CreateSheets()
Dim rng As Range, rngNames As Range
Dim SheetName As String
Dim wks As Worksheet

'Turn off the screen
Application.ScreenUpdating = False

'Get the list of sheet names
With ThisWorkbook.Worksheets("TOC")
Set rngNames = .Range(.Range("A6"), .Range("A6").End(xlDown))
End With

'Loop through the list of sheet names
For Each rng In rngNames

'Store the name for the worksheet
SheetName = Left$(rng.Text, 31)

'See if the sheet already exists
On Error Resume Next 'Suppress an error if sheet not found
Set wks = Nothing
Set wks = ThisWorkbook.Worksheets(SheetName)
On Error GoTo 0

'If it doesn't exist, create it
If wks Is Nothing Then
'Copy the template sheet (which then becomes the active
sheet)
ThisWorkbook.Worksheets("template").Copy
Befo=ThisWorkbook.Worksheets("template")
'Name the copied sheet(which is now active). Sheet names
can only be 31 characters long
ActiveSheet.Name = SheetName

End If
Next rng

'Set Section Name
Dim ws As Worksheet
Dim rSection As Range
Set rSection = ActiveWorkbook.Worksheets("TOC").Range("B6")

For Each ws In ActiveWorkbook.Worksheets
If ws.Name < "TOC" And ws.Name < "template" And ws.Name
< "list" Then
rSection.Offset(0, -1).Value = ws.Name
With ws.Range("D1")
.Value = rSection.Resize(1, .Columns.Count).Value
End With
Set rSection = rSection.Offset(1, 0)
End If
Next ws
End Sub