Jan 12 2023 07:57 AM - edited Jan 12 2023 07:58 AM
I have tried many different things and nothing is working. I want to copy the first sheet and pasted it into the other 25 sheets, while keeping the row/column formatting (as well as all the formatting.) Also, I would like to keep the headers - the one on the left is a date (Design, Date). I want it to bring up the day's date of when I worked on the file. HELP! Thanks! (I am using Windows 10 Pro) Office Excel version 2013.
(Forgive me if this posted 2x - I couldn't find the 1st post)
Jan 13 2023 05:51 AM
Jan 13 2023 06:08 AM
@kvhpkh I'd delete the additional sheets, then run the macro to create new copies. That's much easier than trying to get everything just right if the sheets exist already.
Jan 14 2023 03:21 AM
Jan 14 2023 03:31 AM
Jan 14 2023 04:01 AM
SolutionTry this version:
Sub CreateSheets()
Dim y As Long
Dim w As Long
Dim d As Date
Dim i As Long
Dim s As Worksheet
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
Application.DisplayAlerts = False
For i = Worksheets.Count To 2 Step -1
Worksheets(i).Delete
Next i
Set s = Worksheets(1)
For i = 1 To 25
s.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Format(d + 14 * i, "mmm d")
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Jan 14 2023 04:58 AM
Jan 14 2023 04:01 AM
SolutionTry this version:
Sub CreateSheets()
Dim y As Long
Dim w As Long
Dim d As Date
Dim i As Long
Dim s As Worksheet
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
Application.DisplayAlerts = False
For i = Worksheets.Count To 2 Step -1
Worksheets(i).Delete
Next i
Set s = Worksheets(1)
For i = 1 To 25
s.Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Format(d + 14 * i, "mmm d")
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub