copie onglet avec date

[COLOR="DarkSlateGray"][B]Sub Calendjourfeuille()
Dim mois_année, x&, y&, i&
   Application.ScreenUpdating = False
   mois_année = Val(InputBox("Quelle date ? (Format m-aaaa)"))
   If mois_année = 0 Then Exit Sub
   x = DateValue("1-" & mois_année)
   y = DateSerial(Year(x), 1 + Month(x), 1) - 1
   For i = 0 To y - x
      ActiveWorkbook.Sheets("Feuil1").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Format(x + i, "dd-mmm-yyyy")
   Next
End Sub[/B][/COLOR]

[COLOR="DarkSlateGray"][B]Sub Calendjourfeuille()
Dim mois_année, x&, y&, i&
Dim msgErr$, nErr As Byte
   Application.ScreenUpdating = False
   mois_année = Val(InputBox("Quelle date ? (Format m-aaaa)"))
   If mois_année = 0 Then Exit Sub
   x = DateValue("1-" & mois_année)
   y = DateSerial(Year(x), 1 + Month(x), 1) - 1
   For i = 0 To y - x
      ActiveWorkbook.Sheets("Feuil1").Copy after:=Sheets(Sheets.Count)
      On Error GoTo E
      ActiveSheet.Name = Format(x + i, "dd-mmm-yyyy")
R:    On Error GoTo 0
   Next
[COLOR="SeaGreen"]'[/COLOR]
   If nErr Then
      If nErr > y - x Then
         MsgBox "Aucune feuille n'a été créée."
      Else
         MsgBox "L" & IIf(nErr > 1, "es", "a") & " feuille" & IIf(nErr > 1, "s", "") & " :" & _
            msgErr & vbLf & "n'" & IIf(nErr > 1, "ont", "a") & " pas été créée" & _
            IIf(nErr > 1, "s", "") & " car elle" & IIf(nErr > 1, "s", "") & " existai" & _
            IIf(nErr > 1, "en", "") & "t déjà."
      End If
   End If
[COLOR="SeaGreen"]'[/COLOR]
Exit Sub
E: nErr = 1 + nErr
   msgErr = msgErr & vbLf & Format(x + i, "dd-mmm-yyyy")
   Application.DisplayAlerts = False
   ActiveSheet.Delete
   Application.DisplayAlerts = True
   Resume R
End Sub[/B][/COLOR]