Erreur 1004 liste déroulante cascade

Bonjour,

Je dois faire une liste déroulante en cascade qui vient d'une BDD excel
J'ai réussi grâce à un fichier trouvé sur internet mais le problème est qu'il n'accepte pas certaine cellules qui comporte des chiffres en premier ou des tirets...

Et j'ai donc l'erreur 1004 qui se lance à la ligne 29

Sub CreeListeBD()
 colBD = 1
 colListe = 8
 Set f = Sheets("bd")
 ligne = 1
 f.Cells(ligne + 1, colListe).Resize(1000, 10).Clear
 Set mondico = CreateObject("Scripting.Dictionary")
 For Each c In Range(f.Cells(2, colBD), f.Cells(65000, colBD).End(xlUp))
   mondico(c.Value) = c.Value
 Next c
 f.Cells(ligne, colListe) = "Liste"
 f.Cells(ligne, colListe).Font.Bold = True
 f.Cells(ligne + 1, colListe).Resize(mondico.Count) = Application.Transpose(mondico.items)
 ActiveWorkbook.Names.Add Name:="Liste", RefersTo:=f.Cells(ligne + 1, colListe).Resize(mondico.Count)

 For niv = 2 To 3
    colBD = colBD + 1
    colListe = colListe + 2
    ligne = 1
    For Each c In Range(f.Cells(2, colListe - 2), f.Cells(65000, colListe - 2).End(xlUp))
     If c <> "" And c.Font.Bold <> True Then
      Set mondico = CreateObject("Scripting.Dictionary")
      For Each d In Range(f.Cells(2, colBD), f.Cells(65000, colBD).End(xlUp))
        If d.Offset(, -1) = c Then mondico(d.Value) = d.Value
      Next d
      f.Cells(ligne, colListe) = c
      f.Cells(ligne, colListe).Font.Bold = True
      f.Cells(ligne + 1, colListe).Resize(mondico.Count) = Application.Transpose(mondico.items)
      ActiveWorkbook.Names.Add Name:=Replace(c, " ", "_"), RefersTo:=f.Cells(ligne + 1, colListe).Resize(mondico.Count)
      ligne = ligne + mondico.Count + 1
     End If
    Next c
 Next niv
End Sub