Macro pour sauvergarder sous avec le nom d'une cellule

Sub EnregistrerAvecNom()
'Enregistrer avec le nom situé dans une cellule
Dim rèpDialogue As Variant         'Réponse de la boite de dialogue Excel
Dim cel As Range                   'Cellule contenant le nom du fichier
Dim nomFichier As String           'Nom du fichier (contenu dans la cellule)
Dim nomSaisi As String             'Nom de fichier saisi 
Dim txt As String                  'Titre de la boite de message
Dim msg As String                  'Message pour boite de message
Dim rép As Integer                 'Réponse à une boite de message

 
'Cellule contenant le nom
Set cel = Worksheets(1).Range("A1")
'Nom du fichier
If cel.Formula > "" And TypeName(cel.Value) = "String" Then
  nomFichier = cel.Value & " " & Format(Date, "yyyy-mm-dd") & ".xls"
Else
  nomFichier = "Sans nom " & Format(Date, "yyyy-mm-dd") & ".xls"
End If

'Proposer l'enregistrement
txt = "Enregistrer le fichier avec le nom dans une cellule"
Do
  rèpDialogue = Application.GetSaveAsFilename(nomFichier)
  If rèpDialogue = False Then
    Exit Sub
  End If
  nomSaisi = StrReverse(rèpDialogue)
  nomSaisi = StrReverse(Mid(nomSaisi, 1, InStr(1, nomSaisi & "\", "\") - 1))
  If nomSaisi <> nomFichier Then
    msg = "Confirmer le remplacement du nom," & vbCr & _
          "normalement prévu pour ce classeur :" & vbCr & _
          nomFichier & vbCr & vbCr & _
          "par le nom qui vient d'être saisi :" & vbCr & _
          nomSaisi
    rép = MsgBox(msg, vbExclamation + vbOKCancel, txt)
    If rép = vbOK Then nomFichier = nomSaisi
  End If
Loop While nomSaisi <> nomFichier
On Error GoTo ErrorHandler
ActiveWorkbook.SaveAs Filename:=nomFichier
On Error GoTo 0

Exit Sub

ErrorHandler:          'Routine de gestion d'erreur.
'------------
'Évalue le numéro d'erreur.
Select Case Err.Number
  Case 1004
    'Le fichier est déjà ouvert ou l'enregistrement à été annulé
    If Err.Description = "La méthode 'SaveAs' de l'objet '_Workbook' a échoué" Then
      Resume Next
    Else
      MsgBox "L'enregistrement à échoué :" & vbCr & vbCr & Err.Description, vbInformation, txt
      Resume Next
    End If
  Case Else
    MsgBox Err.Description, vbCritical, txt
    Stop
    Resume Next
End Select

End Sub