Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
[COLOR=NAVY]Dim[/COLOR] Chemin [COLOR=NAVY]As String[/COLOR], Dossier [COLOR=NAVY]As String[/COLOR]
Chemin = Range("A1").Text
Dossier = Range("B1").Text
[B]MkDir [/B]Chemin & Dossier
Option Explicit
Sub Tst()
Dim Dossier As String
Dossier = "C:\Essai1\Essai2\essai3\essai4"
CreerDossier Dossier
End Sub
Private Function CreerDossier(ByVal sChemin As String)
Dim i As Integer
Dim sTmp As String
Dim Ar() As String
Ar = Split(sChemin, "\")
sTmp = Ar(0)
For i = LBound(Ar) + 1 To UBound(Ar)
If Ar(i) <> "" Then
sTmp = sTmp & "\" & Ar(i)
On Error Resume Next
MkDir sTmp
On Error GoTo 0
End If
Next
End FunctionSi tu prends l'exmple de la ligne 2, c'est bien la valeur de "D1", "E1", "F1", "G1" que tu veux récupérer !?
...
Sub Tst()
Dim Dossier As String
Dim sChaine As String
sChaine = Range("D1") & "\" & Range("E1") & "\" & Range("F1") & "\" & Range("G1")
Dossier = ThisWorkbook.Path & "\" & sChaine
CreerDossier Dossier
End SubOption Explicit
Sub Dossier()
Dim Lig As Long, Col As Integer
Dim ColB As String, ColC As String
' Récupère la dernière ligne de la feuille
Derlig = Range("A" & Application.Rows.Count).End(xlUp).Row
' Sauter la 1ère ligne d'entête
For Lig = 2 To Derlig
' Pour chaque colonne
For Col = 1 To 4
' Récupère la valeur de la ligne de la colonne B
ColB = Range("B" & Lig).Value
' Récupère la valeur de la ligne de la colonne C
ColC = Range("C" & Lig).Value
' Vérifie / créé le dossier
CreerDossier ("C:\" & ColB & "\" & ColC & "\" & Cells(1, 3 + Col))
Next Col
Next Lig
End Sub
Private Function CreerDossier(ByVal sChemin As String)
Dim I As Integer, sTmp As String, Ar() As String
' Créé un tableau des différends dossier et sous-dossier
Ar = Split(sChemin, "\")
sTmp = Ar(0)
' Pour le début du chemin jusqu'à la fin
For I = LBound(Ar) + 1 To UBound(Ar)
' Vérifie que le tableau n'est pas vide
If Ar(I) <> "" Then
sTmp = sTmp & "\" & Ar(I)
On Error Resume Next
MkDir sTmp
On Error GoTo 0
End If
Next
End Function ' Récupère la dernière ligne de la feuille
Derlig = Range("A" & Application.Rows.Count).End(xlUp).Row
