Sub CreeSemdansMoisChoisi()
Dim MoisChoisi As Date, Mois, NbJours As Byte, i As Byte
Mois = _
InputBox("Saisir le mois au format mm/aaaa", _
"Choix du mois", _
Format(Date, "mm/yyyy"))
Application.ScreenUpdating = False
If IsDate(Mois) Then
MoisChoisi = CDate(Mois)
NbJours = Day(DateSerial(Year(MoisChoisi), Month(MoisChoisi) + 1, 0))
For i = 1 To NbJours
Select Case Weekday(i & "/" & Mois, vbMonday)
Case 1
ds = CDate(i & "/" & Mois)
fs = ds + 6
Sheets(1).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Format(ds, "d_mmm")
ActiveSheet.Range("B5") = StrConv("Sem: " & Format(ds, "ddd d") & " au " & Format(fs, "ddd d/mm/yyyy"), vbProperCase)
End Select
Next
End If
End Sub