ほとんど書捨て(Write Only)に近いけれどカレンダーらしきものを書いた。
かなり完成度は低い(-＿-；)
実行結果
Option Explicit

Dim dt As Date
Dim last As Integer
Const start_day As Integer = 1
Const limit As Integer = 8

Private Static Sub main()
    
    Dim tmp As Range
    Set tmp = Worksheets(Me.name).Range("A1")
    Dim remain As Integer

    remain = 0

    Call init
    Call this_month_end

    remain = print_week(tmp, 1, first_weekday(), limit - first_weekday(), 0)
    remain = print_week(tmp, 3, vbSunday, vbSaturday, remain)
    remain = print_week(tmp, 5, vbSunday, vbSaturday, remain)
    remain = print_week(tmp, 7, vbSunday, vbSaturday, remain)
    remain = print_week(tmp, 9, vbSunday, vbSaturday, remain)
   
End Sub

Private Sub init()
    dt = 0
    last = 0

End Sub

Private Sub this_month_end()
    Const pre As Double = -1
    ' 次月の末日
    dt = DateSerial(Year(Date), Month(Date) + 1, start_day)
    ' 今月の月末の日付
    dt = DateAdd("d", pre, dt)
    ' 日のみ抽出
    last = day(dt)
End Sub

Function first_weekday() As Integer
    Dim wk As Date

    ' 月初の曜日取得
    wk = DateSerial(Year(Date), Month(Date), start_day)

    ' 日のみ抽出して返す
    first_weekday = Weekday(wk)
    
End Function

' 第n週を表示
Function print_week(ByVal place As Range, ByVal row_step As Integer, ByRef start_pos As Integer, ByRef end_pos As Integer, ByVal day_val As Integer) As Integer
    Dim i As Integer
    Dim day_remain As Integer

    day_remain = day_val

    i = 0
    Do While i < end_pos
        place(row_step, start_pos + i).Value = incr(day_remain)
        i = i + 1
    Loop

     print_week = day_remain

End Function

' 値のインクリメント
Function incr(ByRef dd As Integer)
    dd = dd + 1
    
    If dd > last Then
        Exit Function
    End If

    incr = dd
End Function