XL 2010 Synchronisation de 3 combobox

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rc&, j%, DListe$, n%, SPListe$(), i&
Cells.Validation.Delete 'RAZ
With [Tableau2]
    If Target.Row = 1 Or Target.Column > .Columns.Count Then Exit Sub
    rc = .Rows.Count
    For j = 1 To .Columns.Count Step 2
        DListe = DListe & "," & .Cells(1, j)
        n = n + 1
        ReDim Preserve SPListe(1 To n)
        For i = 1 To rc
            If .Cells(i, j + 1) <> "" Then SPListe(n) = SPListe(n) & "," & .Cells(i, j + 1)
        Next i
        SPListe(n) = Mid(SPListe(n), 2)
    Next j
    DListe = Mid(DListe, 2)
End With
'---listes de validation---
With ActiveCell.Validation
    If ActiveCell.Column Mod 2 Then
        .Add xlValidateList, Formula1:=DListe 'liste des départements
    ElseIf ActiveCell(1, 0) <> "" Then
        n = Application.Match(ActiveCell(1, 0).Text, Split(DListe, ","), 0)
        .Add xlValidateList, Formula1:=SPListe(n) 'liste des sous-préfectures
    End If
End With
End Sub

CreateObject("wscript.shell").SendKeys "%{DOWN}" 'déroule la liste

Option Explicit
Private WithEvents CL As ComboBoxLiées, CA As ControlsAssociés, LCou As Long, TVL()
Private Sub UserForm_Initialize()
   Set CL = CLsCAs.Création.ComboBoxLiées: CL.Plage Feuil1
   Set CA = CLsCAs.Création.ControlsAssociés: Set CA.Colonnes = CL.Colonnes
   CL.Add Me.ComboBox1, "DEPARTEMENT"
   CL.Add Me.ComboBox2, "SOUS-PREFECTURE"
   CL.Add Me.ComboBox3, "PAYS RURAL"
   CA.Add Me.TextBox4, "VILLAGE"
   CA.Add Me.TextBox5, "LOCALISATION"
   CL.CouleurSympa
   CL.Actualiser
   End Sub

Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
   Btn_effacer.Enabled = NbrLgn = 0 Imp Complet
   Ajout.Visible = Complet: Ajout.Enabled = Complet
   If NbrLgn = 1 Then Exit Sub
   LCou = 0: ReDim TVL(1 To 1, 1 To CL.Colonnes.Count)
   CA.ValeursDepuis TVL
   End Sub
Private Sub CL_Résultat(Lignes() As Long)
   If UBound(Lignes) <> 1 Then Exit Sub
   LCou = Lignes(1): TVL = CL.Lignes(LCou).Range.Value
   CA.ValeursDepuis TVL
   End Sub
Private Sub Btn_effacer_Click()
   CL.Nettoyer
   End Sub
Private Sub Ajout_Click()
   CA.ValeursVers TVL
   If LCou = 0 Then
      CL.ValeursVers TVL
      CL.Lignes.Add.Range.Value = TVL
      CL.Actualiser
   Else
      CL.Lignes(LCou).Range.Value = TVL
      End If
   End Sub