date dans une cellule pour un classeur avec une feuille par jour?

Dim cel As Range, fm As Date, dt As Date, chemin$, nom$, temp$

Sub Cree_Feuilles()

    Application.ScreenUpdating = False
  
    With Sheets("1")
        Set cel = .Range("b1")
        fm = Format(DateSerial(Year(cel), Month(cel) + 1, 0), "dd")
        temp = Format(cel, "mmmm")
    End With


    For i = 2 To fm
        cel = cel + 1
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Format(cel, "d")
    Next i

    Call Saved
End Sub

Sub Saved()

    Application.ScreenUpdating = False

    With ActiveWorkbook.Sheets("1")
        Set cel = .Range("b1")
    End With

    temp = Format(cel, "mmmm")
    chemin = ThisWorkbook.Path & "\Classeurs 2018\"  'À ADAPTER
    nom = WorksheetFunction.Proper(temp)
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=chemin & nom & ".xlsx", FileFormat:=xlOpenXMLWorkbook

End Sub

Sub test()
'exemple: pour le mois de février
Application.ScreenUpdating = False
CreationMois 2
End Sub
Private Sub CreationMois(NumMois)
Dim i As Byte, NBJM As Date
NBJM = CDate("1-" & NumMois)
For i = 1 To Day(DateSerial(Year(NBJM), Month(NBJM) + 1, 0))
Sheets.Add(after:=Sheets(Sheets.Count)).Name = i
Next
End Sub