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