Sub ertert()
Dim yr&, mnth(), i&, j&, dt As Date
Dim rw&, t&, arr, r As Range
yr = Sheets("Лист1").Range("AD1").Value
arr = Array("C5", "R5", "AG5", "AV5", "C15", "R15", "AG15", "AV15", "C25", "R25", "AG25", "AV25")
For i = 1 To 12
    ReDim mnth(1 To 6, 1 To 14): rw = 1
    For j = 1 To 31
        dt = DateSerial(yr, i, j)
        If Month(dt) <> i Then Exit For 'added row
        t = Weekday(dt, vbMonday)
        mnth(rw, t * 2 - 1) = j
        If t = 7 Then rw = rw + 1
    Next j
    Range(arr(i - 1)).Resize(UBound(mnth), UBound(mnth, 2)).Value = mnth
Next i
With Range("C5:BI30")
    .Borders.LineStyle = xlNone
    For Each r In .Cells
        If IsNumeric(r.Value) And r.Value > 0 Then r(1, 2).Borders.LineStyle = 1
    Next r
End With
End Sub