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.

Who is Participating?
ShumsDistinguished Expert - 2017Commented:

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
    End If
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
    Selection.Delete Shift:=xlUp
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
Application.DisplayAlerts = True
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
agwalshAuthor Commented:
FANTASTIC! Saved me so much time with this! THANK YOU..
ShumsDistinguished Expert - 2017Commented:
You're Welcome! Glad I was able to help.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.