Create new sheets named after each cell in a range. Do nothing if sheet is already created. Create if not.

[Marzagao]

Hi all

I have the following code but need to tweak it so that on the 2nd time it runs, it no longer creates every single sheet, but only new sheets (not yet on the workbook). Can anyone help? The purpose is to create new sheets based on sheet 'Template'. Also I'm having some trouble on the macro to just run through Range "B2:B6" it seems like it goes all the way down in column B... Thanks in advance!!

Sub CreateSheetsFromAList2()


Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Template")


Dim MyCell As Range, MyRange As Range


Set MyRange = Sheets("Advertisers").Range("B2:B6")
Set MyRange = Range(MyRange, MyRange.End(xlDown))


For Each MyCell In MyRange
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ThisWorkbook.Worksheets("Template (2)").Name = MyCell.Value
Next MyCell


End Sub

 

[JLGWhiz]

How about a remodeling job.

Sub CreateSheetsFromAList3()
Dim ws1 As Worksheet, rng As Range, c As Range, test As String
Set ws1 = Worksheets(1) '("Template")
Set rng = ws1.Range("B2", ws1.Cells(Rows.Count, 2).End(xlUp))
    For Each c In rng
        On Error Resume Next
        If Sheets(c.Value) Is Nothing Then
            If Err.Number > 0 Then
                Err.Clear
                ws1.Copy After:=ThisWorkbook.Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
            End If
        End If
    Next
End Sub

 

[mole999]

it goes all the way down, but you start B2 to B6, and then go down which will extend

if your going to do this in frequently, check out ASAP utilities, it does this stuff in its sleep

 

[Snakehips]

Marzagao,

Similar to Whiz but in the belief that you wish to restrict to range B2:B6 which is within sheet 'Advertisers' ???

Sub CreateSheetsFromAList2()Dim ws, ws1 As Worksheet
Dim MyCell As Range, MyRange As Range
Set ws1 = ThisWorkbook.Worksheets("Template")
Set MyRange = Sheets("Advertisers").Range("B2:B6")
For Each MyCell In MyRange
    If Not MyCell = "" Then
        On Error Resume Next
        Set ws = Nothing
        Set ws = ThisWorkbook.Worksheets(MyCell.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
            ThisWorkbook.Worksheets("Template (2)").Name = MyCell.Value
        End If
    End If
Next MyCell
End Sub

 

[Marzagao]

Thanks guys, I can only post back results in a couple of hours but the code seems pretty good and logic. Snakehips, yes B2:B6 in Advertisers. Thanks for that!

 

[Marzagao]

Thanks a lot! It works great!