Save as le classeur complet et rnomer selon la valeur cellule

[chaelie2015]

Bonsoir Forum
Je souhaite enregistrer sous le fichier complet(le classeur) au bureau et le renomer selon la valeur d'une cellule.
ce code ci dessous il copie une feuille seulement ?
je souhaite le modifier.

Sub Enregistrer_sous()


Dim Chemin As String

Application.ScreenUpdating = False
Chemin = "C:\Users\Desktop" ' Ici ton chemin
Nom = "AO4" ' ici le nom  de la cellule

Sheets("Rapport").Copy

    With ActiveWorkbook
        .SaveAs Filename:=Chemin & " " & Nom
        .Close
    End With
End Sub

Merci par avance

 

[chaelie2015]

Bonsoir Forum
j'ai trouvé ce code dans ce forum , il est parfait.

Sub Enregistrer_sous()
Dim fichier As Variant
With [AQ4]
    If LCase(.Value) & ".xlsm" = LCase(ThisWorkbook.Name) Then Exit Sub
    If .Value = "" Then .Value = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5): Exit Sub
    ChDir ThisWorkbook.Path
    fichier = Application.GetSaveAsFilename(.Value)
    If fichier = False Then .Value = "": Exit Sub
    fichier = Left(fichier, InStrRev(fichier, Application.PathSeparator)) & .Value & ".xlsm"
End With
Application.DisplayAlerts = False 'si le fichier existe déjà
ThisWorkbook.SaveAs fichier
End Sub

Merci Job

 

[Phil69970]

Bonjour Chaelie 2015, bonjour le forum

Sub Enreg()

Application.ScreenUpdating = False

Dim chemin As String, fichier As String

chemin = ThisWorkbook.Path
fichier = chemin & "\" & Range("AO4") & ".xlsm"

ActiveWorkbook.SaveAs Filename:=fichier

Application.ScreenUpdating = True

End Sub

Cordialement

 

[chaelie2015]

Bonjour Phil69970
c'est nickel.
a+