This is what I'm working with. Isn't copying/pasting the TEMPLATE sheet and doesn't have code to open to current date. Anyone assist ?
Code:
Sub ANIMATE_SUPLOG()
Application.ScreenUpdating = False
Dim Mth As Long, dy As Long, DaysInMonth As Long, yr As String, srcWS As Worksheet
Set srcWS = ThisWorkbook.Sheets("Template") 'Name of worksheet that will be compiled to new workbook
askyear:
yr = InputBox("Enter the Year number required" _
& vbCrLf & "in the format of YYYY e.g. " & "2023" _
& vbCrLf & "" _
, "Enter Year Number")
If yr = "" Or Val(yr) = 0 Then Exit Sub
If Val(yr) < 1999 Or Val(yr) > 2100 Then
GoTo askyear
End If
For Mth = 1 To 12
DaysInMonth = DateSerial(yr, Mth + 1, 1) - DateSerial(yr, Mth, 1)
srcWS.Copy
For dy = 1 To DaysInMonth
Sheets(1).Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Format(DateSerial(yr, Mth, dy), "dd MMM yy")
.Range("H2") = Format(DateSerial(yr, Mth, dy), "dd MMMM yyyy")
End With
Next dy
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & Application.PathSeparator & "Sup Log " & Format(Mth, "00") & " " & MonthName(Mth) & " " & yr & ".xlsx", FileFormat:=51
.Close False
End With
Next Mth
Application.ScreenUpdating = True
End Sub