creating sheets from templates

[jondallimore]

Hello,

I have the code below, which generates a series of worksheets from a template based on a list, 'rnglist'.

All good so far, and working.
However...

I now want to set up 10 more templates, which will be Monday 1, Tuesday 1, etc, and also Monday 2, Tuesday 2 etc.
Then I want the code to decide which template to use for each entry in rnglist based on information in column E and column G.
Column A (rnglist) contains the date
Column E (rngday) contains the day
Column G (rngweek) contains which week it is, wk 1 or wk 2.

So... if it is a Monday of Wk 1, I would like to have a sheet created, named with the date in column A (this bit already works), but to create that sheet by copying the Monday 1 template sheet.

Any help greatfully recieved.

Jon

Private Sub CommandButton1_Click()    Dim cell As Range, rnglist As Range
    Dim ws As Worksheet
    Set rnglist = Range("A3", Range("A" & Rows.Count).End(xlUp))
    Set rngday = Range("E3", Range("E" & Rows.Count).End(xlUp))
    Set rngweek = Range("G3", Range("G" & Rows.Count).End(xlUp))
    
    If Sheet2.Cells(3, 1) = "" Then
        Sheet2.Activate
        Cells(3, 1).Select
        Application.DisplayAlerts = False
        For Each ws In Worksheets
        'Keep these non-list sheets
        If InStr("|Navigation|Template|Instructions|", "|" & ws.name & "|") = 0 Then
        'Test if each sheet is on the list
        If WorksheetFunction.CountIf(rnglist, ws.name) = 0 Then ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True
        GoTo Skipout
        Else:
        GoTo Doit
    End If
Doit:
    Application.ScreenUpdating = False
    For Each cell In rnglist
        If cell.Value <> "" Then
            On Error Resume Next
            'test if worksheet exists
            If Len(Worksheets(cell.Value).name) = 0 Then
                On Error GoTo 0
                'copy worksheet named "Template"
                Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)
                ActiveSheet.name = cell.Value 'name new sheet
                'Create hyperlink
                Let x = "'" & cell.Value & "'!A1"
                cell.Parent.hyperlinks.Add Anchor:=cell, _
                                           Address:="", _
                                           SubAddress:=x, _
                                           TextToDisplay:=cell.Value
       
            End If
            On Error GoTo 0
        End If