Re salut
Désolé pour le message précédent mais les pièces jointes ne passent apparemment plus sur les fils. Voici le code.
Cordialement, A+
Sub Enregistre_Sous()
Dim Titi As String
Dim Cellule_en_Cours, Nom
Dim Compteur As Integer, Compteur2 As Integer
Set Cellule_en_Cours = [A23]
Nom = InputBox("Indiquer le premier jour du mois à traiter !", Title:=DateValue(Now()), Default:="01/" & Right("0" & Month(DateValue(Cellule_en_Cours.Value) + 31), 2) & "/" & Year(DateValue(Cellule_en_Cours.Value) + 31))
If IsDate(Nom) Then
Compteur2 = 0
For Compteur = 0 To 30
If Weekday(DateValue(Nom) + Compteur) > 1 And Weekday(DateValue(Nom) + Compteur) < 7 Then
Cellule_en_Cours.Offset(0, Compteur2).Value = DateValue(DateValue(Nom) + Compteur)
Compteur2 = Compteur2 + 1
Else
Cellule_en_Cours.Offset(0, Compteur).FormulaR1C1 = ""
End If
Next Compteur
ChDrive "c"
ChDir "C:\user\mes documents" 'Indiquez le répertoire
Titi = "titi_"
ActiveWorkbook.SaveAs Filename:=Titi & Format(Nom, "mmmm")
End If
End Sub