Sub proc_delete_P()
Dim aSheet As Object
For Each aSheet In ActiveWorkbook.Sheets
If Sheets.Item <> "Лист1" Then Sheets.delete
Exit For
End If
End Sub


Sub shablon_create()
ActiveWorkbook.Worksheets.Add

Dim a As String
a = CStr(Year(Date))
 Range("A1") = "Ожидаемое выполнение за " & a & "год"
    Application.DisplayAlerts = False
    Range("A1:E1").Select
    Selection.Merge
    Application.DisplayAlerts = True
   Range("A2") = "№"
   Range("B2") = "Объект, договор "
   Range("C2") = "Стоимость этапа"
   Range("D2") = "С/С"
   Range("E2") = "С/П "

   
End Sub
Sub s()
  Dim n As Long
  For n =  1  To ThisWorkbook.Worksheets.Count
    If ThisWorkbook.Worksheets(n).Name <> "Лист1" Then
      Worksheets.delete
    End If
  Next n
End Sub

Sub centered_()
Cells( 1 ,  1 ).Select
With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With

End Sub

Sub Page_Add()
Dim i As Integer
If Worksheets.Count >=  12  Then
Exit Sub
Else
For i =  1  To  12 
ActiveWorkbook.Worksheets.Add
Next i
Worksheets( 1 ).Name = "Январь"
Worksheets( 2 ).Name = "Февраль"
Worksheets( 3 ).Name = "Март"
Worksheets( 4 ).Name = "Апрель"
Worksheets( 5 ).Name = "Май"
Worksheets( 6 ).Name = "Июнь"
Worksheets( 7 ).Name = "Июль"
Worksheets( 8 ).Name = "Август"
Worksheets( 9 ).Name = "Сентябрь"
Worksheets( 10 ).Name = "Октябрь"
Worksheets( 11 ).Name = "Ноябрь"
Worksheets( 12 ).Name = "Декабрь"
End If

End Sub

Sub shablon_create()

Dim a As String
Dim b As String
Dim i As Integer
For i =  1  To ActiveWorkbook.Sheets(i).Count
a = CStr(Year(Date))
b = ActiveWorkbook.Sheets.Item
 Range("A1") = "Ожидаемое выполнение за" & b & "месяц" & a & "год"
    Application.DisplayAlerts = False
    Range("A1:E1").Select
    Selection.Merge
    Application.DisplayAlerts = True
   Range("A2") = "№"
   Range("B2") = "Объект, договор "
   Range("C2") = "Стоимость этапа"
   Range("D2") = "С/С"
   Range("E2") = "С/П "
Next i
End Sub

Public Sub CreateCalendarBook()
Dim wbNew As Workbook
Dim wsNew As Worksheet
Dim arMonth() As Variant
Dim i As Long
    
    Application.SheetsInNewWorkbook =  1 
    Application.ScreenUpdating = False
    
    arMonth = Application.GetCustomListContents( 4 )
    
    Set wbNew = Application.Workbooks.Add
    wbNew.Sheets( 1 ).Name = "MustRemoved"
    
    For i = LBound(arMonth,  1 ) To UBound(arMonth,  1 )   ' это я так полагаю организовывает цикл по месяцам

        ThisWorkbook.Activate
        If ActiveWorkbook.Sheets.Count <  14  Then
           Sheets(i).Add
           Sheets(i).Select
           Sheets(i).Name = LCase(arMonth(i))
         WorkSheets(i).Range("A1").Value = "Ожидаемое выполнение за  " & LCase(arMonth(i)) & " " & Year(Now) & " года"
         End If
   Next i
    Application.DisplayAlerts = False
    wbNew.Worksheets("MustRemoved").delete
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    ThisWorkbook.Activate
  MsgBox "Создание книги завершено", vbOKOnly + vbInformation, "Сообщение"
End Sub