Créer un dossier avec un nom contenant la valeur de plusieurs cellule

Bonjour à tous,

J'ai créé une fonction qui me permet de créer un dossier qui prend comme nom la valeur d'une cellule mais je n'arrive pas à l'adapter pour qu'elle affiche le nom de plusieurs cellules.

J'ai ça actuellement :

Et je cherche à faire ce type de dossier :

Ce nom fait référence à la valeur des cellules qui sont présentes ici en position 1 ; 3 et 4 (image ci-dessous ):

Le code de création du dossier ci-dessous :

'*************************
'Procédure de création automatique de dossier
'*************************
Sub creer_dossier()
Dim objFso As Object, objFil As Object
Dim LastLig As Long, r As Long
Dim vDirectory As String, Chemin As String

Chemin = "E:\Suivi Validation VBA\Dossiers Valac\"
Set objFso = CreateObject("Scripting.FileSystemObject")

If Not objFso.FolderExists(Chemin) Then
    MsgBox Chemin & " n'existe pas"
    Exit Sub
End If

With ActiveSheet 'adapte le nom de ta feuille
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For r = 2 To LastLig
        vDirectory = .Cells(r, 1).Value
        If vDirectory <> "" And .Cells(r, 2).Value <> "" Then
            If Not objFso.FolderExists(Chemin & vDirectory) Then objFso.CreateFolder Chemin & vDirectory
        End If
    Next r
End With
Set objFso = Nothing
End Sub

En espérant avoir une réponse à mon interrogation.

Bonne soirée à tous !

Bonjour,

Voici un essai :

'*************************
'Procédure de création automatique de dossier
'*************************
Sub creer_dossier()
Dim objFso As Object, objFil As Object
Dim LastLig As Long, r As Long
Dim vDirectory As String, Chemin As String

Chemin = "E:\Suivi Validation VBA\Dossiers Valac\"
Set objFso = CreateObject("Scripting.FileSystemObject")

If Not objFso.FolderExists(Chemin) Then
    MsgBox Chemin & " n'existe pas"
    Exit Sub
End If

With ActiveSheet 'adapte le nom de ta feuille
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For r = 2 To LastLig
        vDirectory = r-1 & " " & join(application.transpose(application.transpose(.range("C" & r & ":D" & r))), " ")
        If .Cells(r, 2).Value <> "" Then
            If Not objFso.FolderExists(Chemin & vDirectory) Then objFso.CreateFolder Chemin & vDirectory
        End If
    Next r
End With
Set objFso = Nothing
End Sub

Cdlt,

Bonjour,

Votre code marche effectivement bien mais j'ai bug qui apparaît quand le numéro d'article est supérieur à 9.

Quand on rentre la 10ème ligne, j'ai ce message qui s'affiche :

Et la ligne incriminée :

Merci pour votre aide

Bonjour,

Et quelles sont les valeurs correspondantes en C et D ? Car il y a des caractères interdits dans les noms de fichiers et de dossiers. Si je ne dis pas de bêtises, " < > / \ | * ? sont interdits et j'en oublie peut-être...

Cdlt,

Effectivement, il y avait une petite coquille qui s'était glissé dans le nom d'un de mes fichiers .

Merci beaucoup et passez un bon réveillon de Noël !

Merci ! Je vous souhaite également un joyeux Noël et de passer d'excellentes fêtes !

Cordialement,