Enregistrer la copie d'un onglet sur le bureau

Bonjour,

Je souhaite que lorsque l'utilisateur (fichier partagé en réseaux) clique sur le bouton, la copie de l'onglet (copie et colle les données seulement dans le nouvel onglet), puis qu'il enregistre sur le bureau. Actuellement, si j'exécute le code il enregistre dans "Mes documents". Voici le code :

Sub CopieRecapSurBureau()
' ENREGISRTRER LE RECAPITULATIF SUR LE BUREAU
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim chemin As String
Dim CheminBureau As String

CheminBureau = ObtenirCheminBureau()
chemin = Application.ThisWorkbook.Path

    Sheets("Récap").Copy After:=Sheets(11)
    Sheets("Récap (2)").Unprotect "130781"
    Cells.EntireRow.Hidden = False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Shapes.Range(Array("Compteur 1", "Compteur 2", "Graphique 12", "Graphique 13", "Rectangle : coins arrondis 5", "Rectangle : coins arrondis 6", "Rectangle : coins arrondis 7", "Rectangle : coins arrondis 4", "Rectangle : coins arrondis 15")).Delete
    Sheets("Récap").Select
    Sheets("Récap (2)").Range("H4") = ""
    Sheets("Récap (2)").Move

    Sheets("Récap (2)").SaveAs Filename:="Export Récapitulatif Facturation " & Range("C6"), _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
     ActiveWindow.Close

    MsgBox ("Le récapitulatif a été exportée,  le fichier est enregistré dans vos 'Documents'"), vbExclamation, "Export Consultation"
    Application.WindowState = xlNormal
End Sub

Je suis sûre qu'il faut un petit bout de code mais la je zappe.

Bonjour

A tester

Sub CopieRecapSurBureau()
    ' ENREGISTRER LE RECAPITULATIF SUR LE BUREAU
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim chemin As String
    Dim CheminBureau As String

    ' Obtenir le chemin du bureau
    CheminBureau = Environ("USERPROFILE") & "\Desktop\"

    ' Copier l'onglet Récap
    Sheets("Récap").Copy After:=Sheets(11)
    Sheets("Récap (2)").Unprotect "130781"
    Cells.EntireRow.Hidden = False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Shapes.Range(Array("Compteur 1", "Compteur 2", "Graphique 12", "Graphique 13", "Rectangle : coins arrondis 5", "Rectangle : coins arrondis 6", "Rectangle : coins arrondis 7", "Rectangle : coins arrondis 4", "Rectangle : coins arrondis 15")).Delete
    Sheets("Récap").Select
    Sheets("Récap (2)").Range("H4") = ""
    Sheets("Récap (2)").Move

    ' Enregistrer le fichier sur le bureau
    Sheets("Récap (2)").SaveAs Filename:=CheminBureau & "Export Récapitulatif Facturation " & Range("C6"), _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

    MsgBox ("Le récapitulatif a été exporté, le fichier est enregistré sur le bureau."), vbExclamation, "Export Consultation"
    Application.WindowState = xlNormal
End Sub

Bonjour,

Merci pour votre réponse, j'ai une erreur exécution avec :

    Sheets("Récap (2)").SaveAs Filename:=CheminBureau & "Export Récapitulatif Facturation " & Range("C6"), _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close

Bonjour,

Le fil est cloturé...

Merci pour votre réponse, j'ai une erreur exécution avec :

Essayez en modifiant cette ligne

CheminBureau = Environ("USERPROFILE") & "/Desktop/"

Merci de votre retour pour savoir si cela fonctionne ou pas

Cordialement

Edit : essayez aussi comme ceci

CheminBureau = Environ("HOME") & "/Desktop/"

Hello,

ça marche ça sur un Mac ?

CheminBureau = Environ("USERPROFILE") & "/Desktop/"

@Nain

testé sur Excel 2011, cela ne fait pas d'erreur mais cela ne renvoie pas ce qui est attendu

J'ai édité le post pour tester une autre solution

Attendons que Rquantin teste

Fil cloturé sans commentaire

Bonjour, désolé Dan, oui c'est bien clôturé, désolé mais j'étais sur un autre code et j'ai zappé !