Macro to add worksheets based on Cell Values

[s0nicstang]

I want to add new worksheets and name them based on the values of what i have in Col C on my main Tab.

This is what i came up with which will insert only the 1st one on the list?

With Sheets("Main")

Lr = .Range("C5").End(xlDown).Row
For i = 5 To Lr

Set ws = Range("C" & i)
Sheets("Main").Select
Worksheets.Add().Name = ws
Next i

 

[VoG]

Try

With Sheets("Main")
LR = .Range("C" & Rows.Count).End(xlUp).Row
For i = 5 To LR
    Worksheets.Add().Name = .Range("C" & i).Value
Next i
End With

 

[s0nicstang]

Try

With Sheets("Main")
LR = .Range("C" & Rows.Count).End(xlUp).Row
For i = 5 To LR
    Worksheets.Add().Name = .Range("C" & i).Value
Next i
End With

Perfect Thanks!!

 

[badinvestor]

This will ensure that you don't re-create the same tab if it already exists.
Can modify to not copy the first row of data.

Public Sub MoveToTab()
Dim rngRow As Range
Dim rngCell As Range
On Error GoTo ErrHnd
'use All used rows except first, in 'Source' Worksheet
With Worksheets("Role Summary").UsedRange.Offset(3, 0) _
.Resize(Worksheets("Role Summary").UsedRange.Rows.Count - 1, _
Worksheets("Role Summary").UsedRange.Columns.Count)
'loop through all rows
For Each rngRow In .Rows
'test if tab exists
On Error Resume Next
If Not Worksheets(rngRow.Range("A1").Text).Name <> "" Then
On Error GoTo ErrHnd
'No Tab of this name - so create one and copy row
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = rngRow.Range("A1").Text
rngRow.Copy Destination:=Worksheets(rngRow.Range("A1").Text).Range("A1")
Else
On Error GoTo ErrHnd
'worksheet exists
'copy row to end of used range
rngRow.Copy Destination:=Worksheets(rngRow.Range("a1").Text).Range("A1") _
.Offset(Worksheets(rngRow.Range("a1").Text).UsedRange.Rows.Count, 0)
End If
Next rngRow
End With
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub

 

[badinvestor]

With regards to my previous post I have a question of my own the relates to this thread that I hope someone can help with. Using the macro below in addition to creating a tab for each list item I need the macro to then copy all of the information from a seperate worksheet named "Forms Template" and paste it into the newly created tab.
Any suggestions would be great!

This will ensure that you don't re-create the same tab if it already exists.
Can modify to not copy the first row of data.

Public Sub MoveToTab()
Dim rngRow As Range
Dim rngCell As Range
On Error GoTo ErrHnd
'use All used rows except first, in 'Source' Worksheet
With Worksheets("Role Summary").UsedRange.Offset(3, 0) _
.Resize(Worksheets("Role Summary").UsedRange.Rows.Count - 1, _
Worksheets("Role Summary").UsedRange.Columns.Count)
'loop through all rows
For Each rngRow In .Rows
'test if tab exists
On Error Resume Next
If Not Worksheets(rngRow.Range("A1").Text).Name <> "" Then
On Error GoTo ErrHnd
'No Tab of this name - so create one and copy row
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = rngRow.Range("A1").Text
rngRow.Copy Destination:=Worksheets(rngRow.Range("A1").Text).Range("A1")
Else
On Error GoTo ErrHnd
'worksheet exists
'copy row to end of used range
rngRow.Copy Destination:=Worksheets(rngRow.Range("a1").Text).Range("A1") _
.Offset(Worksheets(rngRow.Range("a1").Text).UsedRange.Rows.Count, 0)
End If
Next rngRow
End With
Exit Sub
'error handler
ErrHnd:
Err.Clear
End Sub