Creating and Dating multiple sheets 2 weeks apart

Copper Contributor

How can I create and name 26 sheets at the same time? 

 

I need to date them two weeks apart, starting with the date of the second Friday in January - January 13, 2023.   The sheets following need to be dated 2 weeks apart, i.e.  January 27, Feb. 10, Feb. 24, March 10, etc.   

 

The date format doesn't matter but, my preference would be:   Jan 13, Jan 27, Feb 24...........and so on.  The file will be named with the year 2023.

6 Replies

@kvhpkh 

You can run this macro:

Sub CreateSheets()
    Dim y As Long
    Dim w As Long
    Dim d As Date
    Dim i As Long
    y = InputBox(Prompt:="Enter the year", Default:=Year(Date) + 1)
    w = Weekday(DateSerial(y, 1, 1), vbSaturday)
    d = DateSerial(y, 1, 1) + 14 - w
    Application.ScreenUpdating = False
    For i = 0 To 25
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Format(d + 14 * i, "mmm d")
    Next i
    Application.ScreenUpdating = True
End Sub

I have never run a macro in Excel before. I googled for instructions but, cannot find out how to do this specific macro. Would you mind giving me step by step instructions?

@kvhpkh 

Press Alt+F11 to activate the Visual Basic Editor.

Select Insert > Module.

Copy the code from my previous reply, and paste it into the code module.

Click anywhere in the code, then press F5 to run it.

Switch back to Excel and inspect the result.

You probably won't need to run the macro again. When you close and save the workbook, Excel will display a warning. Click Yes to save the workbook anyway.

Thanks so much! You have saved me a ton of work!
I am trying to set up this year again. But, I can't recall how to get the template to copy on all of the sheets that this macro creates. Can you please help me figure that out? All of the sheets are blank and the template is filled out with text.

@kvhpkh 

Let's say you have a sheet named Template.

Change the macro as follows:

Sub CreateSheets()
    Dim y As Long
    Dim w As Long
    Dim d As Date
    Dim i As Long
    y = InputBox(Prompt:="Enter the year", Default:=Year(Date) + 1)
    w = Weekday(DateSerial(y, 1, 1), vbSaturday)
    d = DateSerial(y, 1, 1) + 14 - w
    Application.ScreenUpdating = False
    For i = 0 To 25
        Worksheets("Template").Copy(After:=Worksheets(Worksheets.Count))
        Worksheets(Worksheets.Count).Name = Format(d + 14 * i, "mmm d")
    Next i
    Application.ScreenUpdating = True
End Sub