Sub sup()
Application.ScreenUpdating = False
Dim TabCode() As Variant
Set dico = CreateObject("Scripting.dictionary")
With Sheets("Liste")
TabCode = .Range("Liste_Codes").Value 'on place tous les codes saisis de la feuille Liste dans un tablo
For i = LBound(TabCode, 1) To UBound(TabCode, 1)
TabCode(i, 1) = Left(TabCode(i, 1), 6) 'on ne garde que les 6 premiers caractères
Next i
End With
For Each ws In Sheets 'on parcourt toutes les feuilles du classeur
With ws 'avec la feuille
If ws.Name <> "Liste" Then 'si on est pas dans la feuille liste
fin = .Cells(3, .Columns.Count).End(xlToLeft).Column 'on récupère la dernière colonne remplie sur la ligne 3
For i = fin To 3 Step -1 'pour chaque élément de la ligne 3 (en partant de la droite)
code = .Cells(3, i) 'on récupère le code
Trouvé = False
For j = LBound(TabCode, 1) To UBound(TabCode, 1) 'on cherche le code dans le tablo
If code Like TabCode(j, 1) & "*" Then 'si les 6 premiers caractères du code sont comme dans la liste
Trouvé = True
Exit For 'on sort de la boucle pour passer au code suivant
End If
Next j
If Trouvé = False Then 'si pas trouvé
If Not dico.exists(code) Then 'si on ne l'avait pas déjà identifié
dico.Add code, ws.Name 'on l'ajoute au dictionnaire
End If
.Columns(i).Delete 'on supprime la colonne 'on supprime la colonne
End If
Next i
End If
End With
Next ws
With Sheets("Liste")
.Range("A2").Resize(dico.Count) = Application.Transpose(dico.keys) ' on colle les codes non trouvés en colonne A de la feuille Liste
'.Range("E15").Resize(dico.Count) = Application.Transpose(dico.items)
a = dico.keys
For i = LBound(a) To UBound(a) 'on créé une chaine de caractère qui contient tous les codes non trouvés
ListePasTrouvé = ListePasTrouvé & "-" & a(i)
Next i
End With
MsgBox "les codes suivants n'ont pas été trouvés: " & Chr(10) & ListePasTrouvé
Application.ScreenUpdating = True
End Sub