Excel VBA enregistrer fichier bureau & renommer par rapport à une cellule

Option Explicit
Dim dossier As String
Dim bureau As String
Sub Enregistrer()
Application.DisplayAlerts = False
cheminbureau
dossier = bureau & "\"
 ActiveWorkbook.SaveAs Filename:=dossier & Sheets("Feuil1").Range("B7").Value & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  MsgBox "Enregistrement du classeur sur le Bureau", vbInformation, "Enregistrement"
    Application.DisplayAlerts = True
End Sub
Private Sub cheminbureau()
'https://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/

    On Error GoTo TestErreur
    Dim cheminbureau As String
    
    cheminbureau = ObtenirCheminBureau()
    
    bureau = cheminbureau 'affiche le chemin vers le dossier Bureau
    Exit Sub
TestErreur:
    MsgBox "Une erreur s'est produite..."
End Sub
Public Function ObtenirCheminBureau() As String
'par: Excel-Malin.com ( https://excel-malin.com )

    On Error GoTo ObtenirCheminBureauError
    Dim cheminbureau As String
    cheminbureau = ""
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    
    cheminbureau = oWSHShell.SpecialFolders("Desktop")
    
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = cheminbureau

    Exit Function
ObtenirCheminBureauError:
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = ""
End Function