Rename worksheet names with entries from list

I am attaching a file and I'm wondering if this needs to be done with a macro or can it be done using formulas e.g. indirect?
1. On the Week names and numbers sheet I have a list of week dates and numbers. Is there a way to create and rename sheets only using the week dates marked in yellow e.g. 3/11/2017, 17/11/2017, 1/12/2017 either using a macro or formulas (ideally it would be great to have it done so that the file with the dates could just be re-created for the following year?
2. Then to have the contents of 03-11-2017 automatically copied to all these newly created renamed sheets..and last but not least,
3. to have the corresponding week date and week numbers for the sheet entered automatically in the areas in yellow on the sheet.

Thanks.
EE_update_sheet_names.xlsx

Hi,

Assuming you have created a Template Sheet for 03-11-17, as per that template below macro will create new sheets as per your requirement:
Try below and let me know:

Option Explicit
Sub CreateSheetsAsPerList()
Dim LR As Long
Dim WkWS As Worksheet, Ws As Worksheet, Temp As Worksheet, xWs As Worksheet, TPWS As Worksheet
Dim StartAtRow, EndAtRow, RowCounter As Long
Dim c As Range
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With
Application.DisplayAlerts = False
For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name <> "Week names and numbers" And xWs.Name <> "Template" Then
        xWs.Delete
    End If
Next
Application.DisplayAlerts = True

Set Temp = Worksheets("Template")
Set WkWS = Worksheets("Week names and numbers")
WkWS.Copy After:=WkWS
ActiveSheet.Name = "TP"
Set TPWS = ActiveSheet
TPWS.UsedRange.Value = TPWS.UsedRange.Value
StartAtRow = 2
EndAtRow = TPWS.Range("A" & Rows.Count).End(xlUp).Row

For RowCounter = StartAtRow To EndAtRow
    TPWS.Rows(RowCounter).Select
    Selection.Delete Shift:=xlUp
Next
LR = TPWS.Range("A" & Rows.Count).End(xlUp).Row
For Each c In TPWS.Range("A2:A" & LR)
    Set Ws = Nothing
    On Error Resume Next
    Set Ws = Worksheets(c.Value)
        If Ws Is Nothing Then
            Sheets("Template").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Format(c.Value, "dd-mm-yy")
            ActiveSheet.Range("J4").Value = c.Value
            ActiveSheet.Range("I5").Value = c.Offset(0, 1).Value
            ActiveSheet.Range("D5").Value = c.Offset(0, 1).Value - 1
            ActiveSheet.Range("D6").Value = c.Offset(0, 1).Value - 1
        End If
Next c
Application.DisplayAlerts = False
TPWS.Delete
Application.DisplayAlerts = True
WkWS.Activate
WkWS.Range("A1").Select
MsgBox "Total " & Worksheets.Count - 2 & " Sheets Created"
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

In attached, just click button create sheets
EE_update_sheet_names_v1.xlsm

Rename worksheet names with entries from list

Who is Participating?

Already a member? Login.