Merci de mon aide,
J'ai réussi avec la code suivant
Dim d As Object, c As Range, a, j&
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each c In Sheets("PLANNING").Range("D6
VH6,D14
VH14,D22
VH22,D30
VH30,D38
VH38,D46
VH46,D54
VH54,D62
VH62,D70
VH70,D78
VH78,D86
VH86,D94
VH94,D102
VH102,D110
VH110,D118
VH118,D126
VH126,D134
VH134,D142
VH142,D150
VH150,D158
VH158,D166
VH166")
d(c.Value) = ""
Next
For Each c In Sheets("PLANNING").Range("D174
VH174,D182
VH182,D190
VH190,D198
VH198,D206
VH206,D214
VH214")
d(c.Value) = ""
Next
'---suppressions en Feuil1---
With Sheets("Feuil1").UsedRange
a = .Columns(1).Resize(, 1) 'matrice, plus rapide, au moins 2 éléments
For j = 1 To UBound(a)
a(j, 1) = IIf(d.exists(a(j, 1)), "sup", 0)
Next
Application.ScreenUpdating = False
Sheets("Feuil1").Columns("b:b").Insert Shift:=xlToRight 'insère une colonne auxiliaire
.Columns(2) = a
ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort.SortFields.Add Key:=Range("Tableau1[[#All],[0]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort
.SortMethod = xlPinYin
.Apply
End With
On Error Resume Next 'si aucune SpecialCell
Sheets("Feuil1").Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
Sheets("Feuil1").Columns("b:b").Delete Shift:=xlToLeft
A présent je regarde pour update mon listbox car il ne se met pas à jour immédiatement, je suis obligé de descendre tout en bas puis remonter la scrollbar.