Remplir un calendrier

Bonjour à tous,

J'aimerais remplir un calendrier avec du code VBA en utilisant les code sui=
vant :

'--
Sub test()
Dim Mois As Integer, Jour As Integer, m As Long
Dim dDate As Date, Ligne As Byte

Ligne = 3
For m = 1 To 12
dDate = Format(DateSerial(Year(Date), Month(Date), 1), "dd/mm/yy"=
)
Mois = m
MsgBox "Mois : " & m
Jour = 0

With Feuil2
.Range("A1").Value = Application.Proper(Format(DateSerial(201=
5, Mois, 1), "mmmm"))

' Efacement de la zone du mois
[modele].Offset(3).ClearContents


For i = 3 To 8
For j = 1 To 7
Debug.Print "Colonne : " & .Cells(i, j).Column, "Weekda=
y : " & Weekday(dDate, 2)
Debug.Print "Mois : " & Month(DateSerial(2015, Mois, Jo=
ur)), "Mois jour-1 : " & Month(DateSerial(2015, Mois, Jour - 1))
If i = 3 And .Cells(i, j).Column < Weekday(dDate, 2) =
Then
Cells(i, j) = ""
Else
Jour = Jour + 1
If Jour <= Day(DateSerial(2015, Mois, 0)) Then
.Cells(i, j) = Jour
If Jour = 1 Then .Cells(i, j).Font.ColorIndex=
= 3
End If
End If
Next j
If j = 8 And Application.CountA(.Range(.Cells(i, 1), .Cel=
ls(i, 8))) > 0 Then
.Cells(i, j) = ""
.Cells(i, 8) = Application.WeekNum(DateSerial(2015, M=
ois, _
Applicati=
on.Min(.Range(.Cells(i, 3), .Cells(i, 8)))))

End If

Next i
If m Mod 2 <> 0 Then
[modele].Copy Feuil1.Range("A" & Ligne)

Else
[modele].Copy Feuil1.Range("J" & Ligne)
Ligne = Ligne + 9
End If
End With
Next m
End Sub
'--

Mais malheureusement les mois ne sont pas remplis correctement ainsi que le=
s numéros des semaines !

http://cjoint.com/?ECmwRk7r52n

Merci d'avance.