Macro pour créer une liste en cascade

[guigol]

Bonsoir,

J'ai beau chercher, je n'arrive pas à reproduire mes différentes trouvailles du forum sur mon cas.

pour présenter mon problème.
_____ je reçois un fichier xls d'un sous-traitant. (formulaire.xls)
_____ j'ai un outil (outil.xls) qui va automatiquement après sélection du bon formulaire, ajouter des colonnes, mettre en forme...

Ce que je souhaite, c'est que sur les colonnes ajoutées, j'ai des listes en cascade.
Je ne souhaite pas lui fournir mes listes en cascade, je ne peux le faire qu'après la réception de son fichier.
Mes différentes listes sont stockés dans un onglet "liste" de mon outil.xls

    formulaire.Worksheets("Formulaire").Activate
    Outil.Sheets("Liste").Copy After:=formulaire.Sheets("Formulaire")
    
    Sheets("Liste").Range(Cells(2, 5), Cells(Range("E" & Rows.Count).End(xlUp).Row, 5)).Name = "Choix1"
    Sheets("Liste").Range(Cells(2, 6), Cells(Range("F" & Rows.Count).End(xlUp).Row, 6)).Name = "Choix2"
    
    With Sheets("Formulaire").Range("M30:M49").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Choix1"
        
        
    End With
    With Sheets("Formulaire").Range("N30:N49").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Choix2"
    End With
    

    
    x = ActiveSheet.CodeName
    
    Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & vbCrLf
    Code = Code & "If Not Intersect([M30:M49], Target) Is Nothing And Target.Count = 1 Then" & vbCrLf
    Code = Code & "Sheets(""Liste"").range(""g2"") = """" " & vbCrLf
    Code = Code & "Sheets(""Liste"").range(""C1:D1000"").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(""Liste"").range(""E1""), Unique:=True" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "If Not Intersect([N30:N49], Target) Is Nothing And Target.Count = 1 Then" & vbCrLf
    Code = Code & "Sheets(""Liste"").[g2] = Target.Offset(, -1)" & vbCrLf
    Code = Code & "Sheets(""Liste"").[C1:D1000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets(""Liste"").[g1:g2], CopyToRange:=Sheets(""Liste"").[F1]" & vbCrLf
    Code = Code & "End If" & vbCrLf
    Code = Code & "End Sub"
    
    With ActiveWorkbook.VBProject.VBComponents(x).CodeModule
        NextLine = .CountOfLines + 1
        .insertlines NextLine, Code
    End With

Avec ca, mes cellules ("M30:M49") recoivent bien choix1 comme liste de validation
Mais les cellules ("N30:N49") ne sont pas dynamiques.

Je vous ai joint le formulaire généré.
Une idée?

 

[pascal21]

Re : Macro pour créer une liste en cascade

BONJOUR
sans avoir regardé ton classeur
pour les listes en cascades: ce lien tiré du site de JB
pour les listes dynamiques: ce lien tiré du site de JB

 

[guigol]

Re : Macro pour créer une liste en cascade

Merci, mon code est tiré de son site.
Mais je bloque.