Duplicate and rename a sheet based on a cell text

[TS656577]

Hello all, I'm looking for some help to duplicate a sheet and rename it based on a cell. I want to have any number of cells filled in with a name (picture shows 1,2,3,4,5,6 but it could be 15 or 20 cells with names) that after pressing a button it duplicates the "vendorblank" sheet and renames it based on the aforementioned cells.

I have this VBA code to create and rename sheets based on cell names, but i'm not sure where to incorporate the code to duplicate this sheet first. It also creates them in reverse order (6,5,4,3,2,1). Any help is greatly appreciated!

Sub CreateVendorSheet()

Dim rng As Range
Dim cell As Range

On Error GoTo Errorhandling

Set rng = Application.InputBox(Prompt:="Select cell range:", _
Title:="Create Vendor Sheet", _
Default:=Selection.Address, Type:=8)

For Each cell In rng

If cell <> "" Then

Sheets.Add.Name = cell
End If

Next cell

Errorhandling:

End Sub

 

[skillilea]

try this

Sub DuplicateAndRenameSheet()
    Dim ws As Worksheet
    Dim newName As String
    Dim i As Integer
    Dim rng As Range, cell As Range
    Dim vendorSheet As Worksheet

    Set vendorSheet = ThisWorkbook.Sheets("vendorblank")

    On Error Resume Next
    Set rng = Application.InputBox(Prompt:="Select cell range:", _
            Title:="Create Vendor Sheet", Default:=Selection.Address, Type:=8)
    On Error GoTo 0
    
    If rng Is Nothing Then
        MsgBox "No range selected. Operation canceled.", vbExclamation
        Exit Sub
    End If
    
    For Each cell In rng
        newName = cell.Value
        
        If newName <> "" Then
            vendorSheet.Copy After:=Sheets(Sheets.Count)

            ActiveSheet.Name = newName
        End If
    Next
End Sub

 

[TS656577]

try this

Sub DuplicateAndRenameSheet()
    Dim ws As Worksheet
    Dim newName As String
    Dim i As Integer
    Dim rng As Range, cell As Range
    Dim vendorSheet As Worksheet

    Set vendorSheet = ThisWorkbook.Sheets("vendorblank")

    On Error Resume Next
    Set rng = Application.InputBox(Prompt:="Select cell range:", _
            Title:="Create Vendor Sheet", Default:=Selection.Address, Type:=8)
    On Error GoTo 0
   
    If rng Is Nothing Then
        MsgBox "No range selected. Operation canceled.", vbExclamation
        Exit Sub
    End If
   
    For Each cell In rng
        newName = cell.Value
       
        If newName <> "" Then
            vendorSheet.Copy After:=Sheets(Sheets.Count)

            ActiveSheet.Name = newName
        End If
    Next
End Sub

Absolute legend. Thank you very much.

 

[skillilea]

Glad to help