repeter jour de 1 a 7 jusqu a fin de mois

bonjour,

Voila mon pb,

j'ai un userform pour generer un calendrier, ou en premier lieu en fonction
du mois choisi je rempli une premiere ligne avec le nb de jours et ensuite
suivant le premier jour du mois( ex 2 pour lundi) je genere les nombre
jusqu'a 7 . pour ca c'est ok
ensuite je recherche la cellule vide a cote du 7 et je genere les nombre de
1 a 7 mais mon est que je souhaite repeter ceci jusqu au dernier jour du mois.
voici la macro:
Dim valeur As String, Ligne As Integer, c As Range
Dim strDate(1 To 2) As String
Dim nmois As String
Dim nannee As Integer
Dim yearin As String
Dim mydate As Variant
Dim jour As Variant
strDate1 = Date
strDate1 = Format(Date, "m")
strDate2 = Date
strDate2 = Format(Date, "mm")
jour = Format(Date, "ddd")
'-'
'Change Month Format'
'-'
If Mois.Value = "Janvier" Then
nmois = "1"
ElseIf Mois.Value = "Février" Then
nmois = "2"
ElseIf Mois.Value = "Mars" Then
nmois = "3"
ElseIf Mois.Value = "Avril" Then
nmois = "4"
ElseIf Mois.Value = "Mai" Then
nmois = "5"
ElseIf Mois.Value = "Juin" Then
nmois = "6"
ElseIf Mois.Value = "Juillet" Then
nmois = "7"
ElseIf Mois.Value = "Août" Then
nmois = "8"
ElseIf Mois.Value = "Septembre" Then
nmois = "9"
ElseIf Mois.Value = "Octobre" Then
nmois = "10"
ElseIf Mois.Value = "Novembre" Then
nmois = "11"
ElseIf Mois.Value = "Décembre" Then
nmois = "12"
End If
nannee = Year(Now)
'--'
'Check month select with month actually'
'--'
If nmois < strDate1 Then
MsgBox ("Creation Pointage Impossible")
Exit Sub
Else: GoTo Lemois
End If

'-'
'Number of day by month'
'-'
Lemois:
Select Case nmois
Case 1, 3, 5, 7, 8, 10, 12
nbjours = 31
Case 4, 6, 9, 11
nbjours = 30
''
'Special case about February'
''
Case Else
If Day(DateSerial(nannee, 2, 28) + 1) = 29 Then
nbjours = 29
Else
nbjours = 28
End If
End Select
'-'
'search first day of month selected'
'-'
yearin = Year(Now)
mydate = DateSerial(yearin, nmois, 1)
joursem = Weekday(mydate)
jour = joursem
jour = Format(joursem, "ddd")
'MsgBox "Pointage Demandé en Date du " & jour & " " & mydate
'--'
'Search if Workbooks exist with same Month name select'
'--'
Existemois:
If Dir("\\Dg6lb076\partagé\FM_" & yearin & "\Pointage_" & strDate2 & "_"
& Mois.Value & ".xls") = "" Then
GoTo Create
Else: MsgBox "Pointage Demandé Déjà Existant", vbExclamation
Exit Sub
End If
'-'
'Create Excel Sheets'
'-'
Create:
Application.Workbooks.Open
("\\Dg6lb076\partagé\FM_2005\Create_Pointage_First_Page.xls")
For i = 1 To nbjours
Range("d7").Cells(1, i).Value = i
Next
For i = joursem To 7
Range("d6").Cells(1, i - (joursem - 1)).Value = i
Next
Range("d6").Cells(1, (8 - joursem) + 1).Select
valeur = Empty
For Each c In Selection
If c.Value = valeur Then
Ligne = c.Column
End If
Next c
For i = 1 To 7
Cells(6, Ligne).Cells(1, i).Value = i
Next

End Sub