Copy template worksheet multiple times and rename based on a list that can change

kpb

New Member
Joined
Nov 16, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hi All

new member here!

I have a situation where i need to copy a template tab multiple times, and name these new tabs as per a pre-defined list. I found the below code on this forum

Sub CreateSheetsFromList()
Dim ws As Worksheet, Ct As Long, c As Range
Set ws = Worksheets("Template")
Application.ScreenUpdating = False
For Each c In Sheets("Tabs").Range("E1:E700")
If c.Value <> "" Then
ws.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Ct = Ct + 1
End If
Next c
If Ct > 0 Then
MsgBox Ct & " new sheets created from list"
Else
MsgBox "No names on list"
End If
Application.ScreenUpdating = True
End Sub

This works the first time its run, except for when i get to a point in my reference list where there are duplicate values. What i am looking for is how to make it ignore the duplicates (create the first value) and then move on to the next unique reference in the list

The tabs could be named anywhere from 1 to 700, for example initially 1, 5, and 422, but then updated to add 4, 10, 200, 399, 437, and 689 and was also wondering is the tabs could be sorted numerically each time it's run?

Thank you
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Hi,
try this update to your code & see if does what you want

VBA Code:
Sub CreateSheetsFromList()
    Dim ws              As Worksheet, Ct As Long
    Dim rng             As Range, c As Range
    
    Set ws = Worksheets("Template")
    
    Set rng = Worksheets("Tabs").Range("E1:E700")
    
    Application.ScreenUpdating = False
    
    For Each c In rng.Cells
        
        If Len(c.Value) > 0 Then
            If Not Evaluate("ISREF('" & c.Value & "'!A1)") Then
                ws.Copy after:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
                Ct = Ct + 1
            End If
        End If
        
    Next c
    
    rng.Parent.Activate
    
    Application.ScreenUpdating = True
    MsgBox IIf(Ct > 0, Ct & " New sheets created from list", "No names On list")
    
End Sub

Dave
 
Upvote 0
Solution
Yes, that appears to work correctly, just making sure. Do you know if there is a way to automate the re-sorting the Tabs numerically?
 
Upvote 0
Yes, after testing it a number of times it seems to creating copies of the worksheet perfectly. Is there a way to include resorting the numbered Tabs numerically or would that require another code?
 
Upvote 0
dmt32, thank you for your quick and correct response that helped me resolve my original question
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,957
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top