Help; create Macro to duplicate and rename tabs

[endlessboundless]

Hello,

Wondering if someone can help me out here. I have a tab that I want to duplicate based a list, and each new tab that is created, I would like it to be renamed based on this list. Could anyone help me out with a macro.

example Tab1 = Template

List
5210
5211
5212
ect

So a macro to duplicate "template" and create 3 tabs named 5210, 5211, and 5212. I would like the macro to be flexible so that if the list is larger, it will capture all.

TYIA
Amit

 

[Weaver]

Try the following in a standard module

Sub newtabs()
    With Sheets("template")
        For Each t In .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
            If Not sheetExists(t) and t <> "" Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = t
        Next
    End With
End Sub

Function sheetExists(ByVal sname As String) As Boolean
    On Error Resume Next
    sheetExists = Sheets(sname).Range("A1").Cells.Count = 1
End Function

Make sure your sheet names are in column A in the 'template' tab and preferably begin in A1

HTH

PS the extra function makes sure there's no conflict with duplicate names.

 

[endlessboundless]

Hi,

The list is not in the template tab, its on a separate "input" tab. The template tab is what I want to duplicate based on the list.

Would this still work?

Thanks,
Amit

 

[endlessboundless]

I have this so far... but it gives me an error at "ActiveSheet.Name = cell" at the end.... highlighted in yellow. Also, it duplicates the cells I want but gives me one extra one. Any help? Thanks!

Function SheetExists(strSheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
SheetExists = False
On Error Resume Next
SheetExists = Len(Sheets(strSheetName).Name) > 0
On Error GoTo 0
End Function
Sub DuplicateRenameSheets()
Sheets("Input").Activate
For Each cell In Sheets("Input").Range("D17", Range("D65536").End(xlUp))
If Not SheetExists(cell.Value) Then
Sheets("template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = cell
End If

Sheets("input").Activate
Next
End Sub