demande modification et verification code vba

Bonjour,

Je sollicite les experts en vba. J'ai le fichier excel suivant Pièce jointe 622164

et j'ai le code ci-dessous. Je m'excuse d'avance pour raisons de politique de sécurité avec le travail la macro est shootée.

Mon but est de créer un dossier à partir d'un bouton situé dans l'onglet "Accueil" de la forme suivante timestamp_nomcelluleE20.

Cependant là où le bas blesse c'est qu'il me crée le dossier uniquement avec le timestamp_

Pour info, dans l'onglet "Info producteur des données" le résultat fonctionnait bien mais il fallait sélectionner la cellule E20.

Là du fait que je veuille placer ce bouton sur la page "Accueil" je ne sais pas trop comment faire. Je souhaiterai justement enlever le fait qu'il faille absolument sélectionner la cellule E20

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub creationdossierdepot() Dim cell As Range For Each cell In Selection On Error Resume Next If Len(Dir(ThisWorkbook.Path & "\" & Worksheets("Info producteur des données").Value("E20"), vbDirectory)) = 0 Then MkDir (((ThisWorkbook.Path & "\" & Format(Now, "YYYYmmddHHMMSS_")) & Replace(Replace(cell.Value, "YYYYmmddHHMMSS_", ""), ".tar.gz", ""))) End If Next cell On Error GoTo 0 MsgBox "Le dossier a été créé. Veuillez insérer les données dedans puis suivre les instructions du readme.txt" End Sub

---

Par avance merci pour votre aide

Guibs

Re-bonjour


Bon j'ai trouvé ma solution moi-même lol je vous partage le code

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub creationdossierdepot() Dim cell As Range For Each cell In Selection On Error Resume Next If Len(Dir(ThisWorkbook.Path & "\" & Worksheets("Info producteur des données").Range("E20").Value, vbDirectory)) = 0 Then MkDir (((ThisWorkbook.Path & "\" & Format(Now, "YYYYmmddHHMMSS_")) & Replace(Replace(Worksheets("Info producteur des données").Range("E20").Value, "YYYYmmddHHMMSS_", ""), ".tar.gz", ""))) End If Next cell On Error GoTo 0 MsgBox "Le dossier a été créé. Veuillez insérer les données dedans puis suivre les instructions du readme.txt" End Sub

---