Option Explicit
Sub CreateSheets()
Const lngFirstWorkDay = vbMonday
Dim lngYear As Long
Dim lngMonth As Long
Dim lngOption As Long
Dim rngHolidays As Range
Dim d As Date
Dim wsh As Worksheet
Dim f As Boolean
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In Application.ActiveWorkbook.Worksheets
If ws.Name <> "Template" Then
ws.Delete
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
lngYear = Val(InputBox("For which year do you want to create sheets?"))
If lngYear < 2000 Or lngYear > 2100 Then
MsgBox "Year not valid! Please try again.", vbInformation
Exit Sub
End If
lngMonth = Val(InputBox("For which month (1 ... 12) do you want to create sheets?"))
If lngMonth < 1 Or lngMonth > 12 Then
MsgBox "Month not valid! Please try again.", vbInformation
Exit Sub
End If
lngOption = 1
If lngOption < 1 Or lngOption > 1 Then
MsgBox "Option not valid! Please try again.", vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
d = DateSerial(lngYear, lngMonth, 1)
Do
f = True
Sheets("Template").Range("A1:Z100").Copy 'adjust range in Template to copy here
If f Then
Set wsh = Worksheets.Add(After:=Worksheets(Worksheets.Count))
wsh.Name = Format(d, "yyyy_mm_dd")
Range("A1").PasteSpecial xlPasteAll
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
Range("A1").Select
End If
d = d + 1
Loop Until Month(d) <> lngMonth
Sheets("Template").Activate
Sheets("Template").Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "All Sheets Created", vbExclamation, "Done !"
End Sub