Comment créer un dossier sur le bureau avec la valeur d'une cellule ?

Bonjour à tous,

Je vous partage mon astuce pour créer un dossier sur le bureau avec pour nom la valeur d'une cellule.

Commencer par :

Dim NomDossier
NomDossier = Sheets("Onglet").Range("A1")

'Onglet étant l'onglet dans lequel se situe la valeur que vous souhaitez récupérer
'A1 est la cellule dans laquelle se trouve la valeur

Puis, vérification si le dossier existe déjà et création du dossier :

If Dir("C:\Users\test\Desktop\" & NomDossier & "\", 16) = "" Then MkDir ("C:\Users\test\Desktop\" & NomDossier & "\")

'test étant votre session Windows et donc votre nom d'utilisateur

Si vous enregistrez votre fichier Excel dans le dossier créé (et j'en suis certain), voici ce qu'il faut faire :

Dim NFic$
NFic = "C:\Users\test\Desktop\" & NomDossier & "\" & Sheets("Onglet").Range("A1")

'Cela renomme le fichier avec la même valeur que l'étape numéro 1 (Dim NomDossier)

'Enregistrement du classeur avec les macros
ActiveWorkbook.SaveAs Filename:=NFic, FileFormat:=52

Bonjour SENPAN,

Nous avons mis ton "astuce" ici
ceci dit à mes yeux il y a un hic... le chemin d'accès au bureau qui n'est jamais celui donné

Je mets donc ici un code générique, cerise sur le gâteau, on peut renommer le fichier

Sub CréationDossierBureau()
  Dim CheminBureau As String, NomDossier As String, NomFichier As String, Ext As String
  ' Le nom du dossier se trouve dans la feuille 1 en A1
  NomDossier = Sheets("Feuil1").Range("A1")
  ' On récupère le chemin d'accès au bureau du PC
  CheminBureau = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
  ' Vérification si dossier existe
  If Dir(CheminBureau & NomDossier & "\", vbDirectory) = "" Then
    MkDir (CheminBureau & NomDossier & "\")
  End If
  ' Nom du fichier actuel
  NomFichier = ThisWorkbook.Name
  ' récupérer son extension '.xls, .xlsm, .xltm, .xlsb
  Ext = Right(NomFichier, Len(NomFichier) - InStrRev(NomFichier, ".") + 1)
  ' Définir le nouveau nom (si souhaité)
  NomFichier = "NEW_" & Format(Date, "yyyymmdd")
  ' Enregistrer ce classeur avec les macros dans le dossier créé, sous le nom définit
  ThisWorkbook.SaveAs CheminBureau & NomFichier & Ext
End Sub

A+