Option Explicit
Sub CalenMorphine()
Dim D As Date, L As Integer, C As Byte, Cp As Byte, T(1 To 50, 1 To 7), Mois As Integer, An As Integer
D = DateSerial(Year(Date), Month(Date), 1)
Do While L < UBound(T, 1) - 5
L = L + 1: T(L, 1) = WorksheetFunction.Proper(Format(D, "mmmm yyyy"))
L = L + 1: For C = 1 To 7: T(L, C) = Choose(C, "Lundi", "Mardi", _
"Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche"): Next C
Mois = Month(D)
Do: Cp = C: C = Weekday(D, 2): If C < Cp Then L = L + 1
If L > UBound(T, 1) Then Exit Do
If D Mod (3) = 2 Then
T(L, C) = Day(D) & " " & IIf((D \ 3) Mod 2, "D", "G")
Else: T(L, C) = Day(D): End If
D = D + 1: Loop Until Month(D) <> Mois
If C < 7 Then T(L, C + 1) = "'"
L = L + 1: Loop
ActiveSheet.[B2].Resize(UBound(T, 1), UBound(T, 2)).Value = T
End Sub