Copier feuille dans nouveaux classeur sur le bureau

Bonjour à tous,

Encore et toujours besoin d'aide …

Je cherche un code vba me permettant :

• de copier la feuille ("BdD") du classeur actif pour la coller dans un nouveau classeur
• que ce classeur soit nommé "extraction base de donnée" + date soit "extraction base de donnée 21022020" par exemple
• et placer ce classeur sur mon bureau
• et tout cela sans que des messages de liens ou de format d'enregistrement avec ou sans macro vienne polluer l'ensemble …
• et enfin quel que soit le chemin du bureau en fonction de l'ordinateur ou de l'utilisateur employé …

Merci par avance ...

Bonsoir,

un classeur qui pourrait vous orientez dans votre projet :

@ bientôt

LouReeD

Bonjour,

2 propositions à tester !?

Cdlt.

Public Sub SaveSheetInNewBook_1()
Dim wb As Workbook, ws As Worksheet, strPath As String, strFile As String
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("BdD")
    strPath = Environ("UserProfile") & "\Desktop\"
    strFile = "extraction base de données " & Format(VBA.Date, "yyyymmdd") & ".xlsx"
    ws.Copy
    With ActiveWorkbook
        .SaveAs Filename:=strPath & strFile, FileFormat:=51
        .Close savechanges:=False
    End With
End Sub

Public Sub SaveSheetInNewBook_2()
Dim wb As Workbook, ws As Worksheet, oWSHShell As Object, strPath As String, strFile As String
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("BdD")
    Set oWSHShell = CreateObject("WScript.Shell")
    strPath = oWSHShell.specialfolders("Desktop") & Application.PathSeparator
    strFile = "extraction base de données " & Format(VBA.Date, "yyyymmdd") & ".xlsx"
    ws.Copy
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .SaveAs Filename:=strPath & strFile, FileFormat:=51
        .Close savechanges:=False
    End With
    Set oWSHShell = Nothing
End Sub

Merci LouReeD et Jean-Eric pour votre aide.

J'applique la première solution de Jean-Eric en rajoutant la ligne "Application.DisplayAlerts = False" et c'est parfait !