Rename worksheet names with entries from list

agwalsh used Ask the Experts™
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.

Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Managing Director/Excel VBA Developer
Distinguished Expert 2018

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


FANTASTIC! Saved me so much time with this! THANK YOU..
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

You're Welcome! Glad I was able to help.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial