[XL-2016] Problème de codage pour liste cascade intuitive à 2 entrées

Bonjour à tous,

Je me suis permis de télécharger le fichier "Liste cascade intuitive département/Ville" sur le site Internet http://boisgontierjacques.free.fr/. Sur la base de celui-ci, je voulais créer un fichier de saisie des données pour des marchandises. Je m'explique :
- dans une feuille "ListeIntuitive", je possède une base de données comportant 2 colonnes : colonne 1, dont l'entête se nomme "Marchandise", regroupe les différentes marchandises proposées par les fournisseurs. Il y a des doublons car des marchandises identiques sont distribuées par différents fournisseurs. J'ai défini le nom "marchandise" à la liste des marchandises (sans l'intitulé de la colonne). La colonne 2, dont l'entête se nomme "Fournisseur" regroupe les noms des fournisseurs (nom de la plage, sans l'intitulé de la colonne = "fournisseur)
- dans une autre feuille, "SaisieMarchandise", je saisis mes données en indiquant en premier le nom du fournisseur, dans la cellule C6 et ensuite je choisis la marchandise dans la cellule D6. j'utilise qu'une seule ligne de saisie.
LE PROBLEME : la première liste déroulante fonctionne, mais ensuite je ne retrouve aucun enregistrement dans la deuxième liste déroulante contenant les marchandise. J'ai modifié le code VBA comme ci-dessous :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Dim TblFournisseur(), TblMarchandise(), fournisseur(), marchandise()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([c6:c6], Target) Is Nothing And Target.Count = 1 Then
    fournisseur = Application.Transpose(Sheets("ListeIntuitive").Range("fournisseur").Value)
    Set d1 = CreateObject("Scripting.Dictionary")
    For Each c In fournisseur
     If c <> "" Then d1(c) = ""
    Next c
    TblFournisseur = d1.keys
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
  Else
    Me.ComboBox1.Visible = False
  End If
  '----
  If Not Intersect([d6:d6], Target) Is Nothing And Target.Count = 1 Then
    Condition = UCase(Target.Offset(, -1))
    If Condition = "" Then Exit Sub
    marchandise = Application.Transpose(Sheets("ListeIntuitive").Range("marchandise").Value)
    fournisseur = Application.Transpose(Sheets("ListeIntuitive").Range("fournisseur").Value)
    ReDim TblMarchandise(1 To UBound(fournisseur))
    Set d1 = CreateObject("Scripting.Dictionary")
    For i = LBound(marchandise) To UBound(marchandise)
      If fournisseur(i) = Condition Then d1(marchandise(i)) = ""
    Next i
    TblMarchandise = d1.keys
    Me.ComboBox2.List = TblMarchandise
    Me.ComboBox2.Height = Target.Height + 3
    Me.ComboBox2.Width = Target.Width
    Me.ComboBox2.Top = Target.Top
    Me.ComboBox2.Left = Target.Left
    Me.ComboBox2 = Target
    Me.ComboBox2.Visible = True
    Me.ComboBox2.Activate
    'Me.ComboBox2.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
  Else
    Me.ComboBox2.Visible = False
  End If
End Sub
Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, fournisseur, 0)) Then
   Set d1 = CreateObject("Scripting.Dictionary")
   tmp = UCase(Me.ComboBox1) & "*"
   For Each c In TblFournisseur
     If UCase(c) Like tmp Then d1(c) = ""
   Next c
   Me.ComboBox1.List = d1.keys
   Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1 ': ActiveCell.Offset(, 1) = "": ActiveCell.Offset(, 2) = ""
End Sub
Private Sub ComboBox2_Change()
 If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, marchandise, 0)) Then
   Set d1 = CreateObject("Scripting.Dictionary")
   tmp = UCase(Me.ComboBox2) & "*"
   For Each c In TblMarchandise
     If UCase(c) Like tmp Then d1(c) = ""
   Next c
   Me.ComboBox2.List = d1.keys
   Me.ComboBox2.DropDown
 End If
   ActiveCell.Value = Me.ComboBox2
End Sub
 
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox2.List = TblMarchandise
  Me.ComboBox2.Activate
  Me.ComboBox2.DropDown
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = TblFournisseur
  Me.ComboBox1.Activate
  Me.ComboBox1.DropDown
End Sub
 
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 ' If KeyCode = 13 Then ActiveCell.Offset(1).Select
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 ' If KeyCode = 13 Then ActiveCell.Offset(, 1).Select
End Sub

...mais je reste bloqué et là je ne trouve pas de solution. J'ai pourtant essayer de prendre le fichier de base et de coller mes valeurs dans la base de données mais ça ne fonctionne toujours pas.
Auriez-vous une solution pour moi ?

Merci d'avance pour vos aides