Code pour créer des répertoires ou le noms est dans une colonne

[Phiphi27700]

Bonjour à tous
Je cherche un code VBA pour créer a partir d'un bouton des répertoire avec leurs feuilles excel.
je joins un petit fichier ou je souhaite a partir de la colonne A:A qui porte un certain nombre de référence et juste en dessous les pièces qui vont avec.
Je souhaite lancer a partir d'un bouton une macro qui me crée des répertoire portant les références de la colonne A:A avec son nom (surligné en jaune)
Dans se répertoire il faut une feuille ou est collé les valeurs chacun des références avec ces pièces
Le fichier joint n'est qu'un exemple en fait il y aura plusieurs centaines de répertoires a créer.
Merci et bonne soirée

 

[camarchepas]

Re : Code pour créer des répertoires ou le noms est dans une colonne

Bonsoir ,

Donc à régler le répertoire de création principal en déclarant dans Chemin la bonne valeur au lieu de "c:\temp\"

Sub Arbo()
Dim LigneFin As Long, Tourne As Long, Ligne As Long
Dim Temoin As Boolean
Dim Chemin As String, Nom As String

Chemin = "c:\temp\"

With ThisWorkbook.Sheets("Feuil1")
 LigneFin = .Range("B" & Rows.Count).End(xlUp).Row
 For Tourne = 2 To LigneFin
  If Temoin And .Range("A" & Tourne) <> "" Then Workbooks(Nom).Close True: Temoin = False
   If .Range("A" & Tourne) <> "" Then
     Nom = Range("A" & Tourne) & "_" & Range("B" & Tourne) & ".xlsx"
     ChDir Chemin
     MkDir Nom
     Application.Workbooks.Add
     ActiveWorkbook.SaveAs Filename:=Chemin & Nom & "\" & Nom
     Temoin = True
     Ligne = 1
    Else
     Workbooks(Nom).Sheets("Feuil1").Range("A" & Ligne & ":C" & Ligne) = ThisWorkbook.Sheets("Feuil1").Range("B" & Tourne & ":d" & Tourne).Value
     Ligne = Ligne + 1
   End If
   
 
Next
End With
End Sub

 

[Phiphi27700]

Re : Code pour créer des répertoires ou le noms est dans une colonne

Bonjour merci
Le code ne fonctionne pas et s’arrête

Sub Arbo()
Dim LigneFin As Long, Tourne As Long, Ligne As Long
Dim Temoin As Boolean
Dim Chemin As String, Nom As String

Chemin = "C:\Downloads\Tempo"

With ThisWorkbook.Sheets("Feuil1")
 LigneFin = .Range("B" & Rows.Count).End(xlUp).Row
 For Tourne = 2 To LigneFin
  If Temoin And .Range("A" & Tourne) <> "" Then Workbooks(Nom).Close True: Temoin = False
   If .Range("A" & Tourne) <> "" Then
     Nom = Range("A" & Tourne) & "_" & Range("B" & Tourne) '& ".xlsx"
     ChDir Chemin
     MkDir Nom
     Application.Workbooks.Add
     [COLOR="#FF0000"]ActiveWorkbook.SaveAs Filename:=Chemin & Nom & "\" & Nom[/COLOR]
     Temoin = True
     Ligne = 1
    Else
     Workbooks(Nom).Sheets("Feuil1").Range("A" & Ligne & ":C" & Ligne) = ThisWorkbook.Sheets("Feuil1").Range("B" & Tourne & ":d" & Tourne).Value
     Ligne = Ligne + 1
   End If
   
Next
End With
End Sub

J'ai changé le chemin et j'ai mis le code dans un module je lance la macro et rien il me crée bien un repertoire mais c'est tout
A l'avance merci

 

[camarchepas]

Re : Code pour créer des répertoires ou le noms est dans une colonne

Ok ,

mais dans mon fichier ça fonctionne

regardes

 

[camarchepas]

Re : Code pour créer des répertoires ou le noms est dans une colonne

Il manque un truc dans chemin

"C:\Downloads\Tempo\" ' le \

 

[Phiphi27700]

Re : Code pour créer des répertoires ou le noms est dans une colonne

Ok merci j'ai la même chose il a fonctionné mais se que je veux c'est bien des répertoire portant le numero suivant du nom mais qu'il crée un fichier excel comme le fichier joint.
repertoire avec MO815206_Verin + dedans un fichier excel MO815206_Verin.xlsx
repertoire avec MO815207_Bloc N°1+ dedans un fichier excel MO815207_Bloc N°1.xlsx
etc...
j'espere etre claire
Merci

 

[Phiphi27700]

Re : Code pour créer des répertoires ou le noms est dans une colonne

Merci oui je viens de voir qu'il manquait "\" j'ai rectifié
Merci pour ton aide et bonne soirée