Créer répertoires en fonction d'une cellule

Je n'ai pas testé mais essaie comme ça :

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rep1 As String, rep2$, rep$
        If Target.Count > 1 Then Exit Sub    'on sort de la procédure si plusieurs cellules sélectionnées
       If Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
            rep1 = "C:\Archives\Recensement\Dossier d'archivage " & Target
            rep2 = "Dossier_d'archive_" & Target.Offset(, -2)    'Target.Offset(, -2)=valeur de la colonne A
           rep = rep1 & "\" & rep2
            If Target <> "" Then
                If Dir(rep, vbDirectory) = "" Then    'si le répertoire n'existe pas
                   If Dir(rep1, vbDirectory) = "" Then MkDir rep1    'on crée le début du répertoire
                   MkDir rep    'on crée le Dossier_d'archive_XXX
                   MkDir rep & "\Dossier_client"    'md Dossier_client
                   MkDir rep & "\Dossier_interne"    'md Dossier_interne
                   MkDir rep & "\Dossier_interne\Performances"    'md Performances
                   MkDir rep & "\Dossier_interne\Defauts"    'md Defauts
                   MkDir rep & "\Dossier_interne\Vibrations"    'md Vibrations
                   MkDir rep & "\Dossier_interne\Vibrations\1ere_Marche"    'md 1ere_Marche
               End If
            End If
        End If
    End Sub

Carrément au top .... merci mille fois pour ton aide Avec ça et ta fonction personnalisé pour vérifier les liens, je vais pouvoir terminer.

Rechercher des sujets similaires à "creer repertoires fonction"