Sub SupprCustRef()
Dim derlig&, i&, ref, neq, t, r, colBH&, colCG&, effacer As Boolean, N&, M&
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
derlig = Cells(Rows.Count, "bh").End(xlUp).Row
If derlig = 2 Then Exit Sub
For i = Cells(Rows.Count, "bh").End(xlUp).Row To 3 Step -1
ref = Cells(i, "by")
On Error Resume Next
neq = Application.Match(ref, Worksheets("liste").Columns("b:b"), 0)
On Error GoTo 0
If Not IsError(neq) Then
Range("bh" & i & ":cg" & i).Delete xlShiftUp: N = N + 1
End If
Next i
derlig = Cells(Rows.Count, "bh").End(xlUp).Row
If derlig <= 3 Then Exit Sub
Range(Cells(2, "bh"), Cells(derlig, "cg")).Sort key1:=Range("by2"), order1:=xlAscending, Header:=xlYes
t = Range("bh1:by" & derlig + 1)
colBH = 1: colCG = UBound(t, 2)
For i = derlig + 1 To 3 Step -1
If InStr(t(i, colBH), "XXXXXX") > 0 Then
effacer = False
effacer = (t(i + 1, colCG) = t(i, colCG)) Or (t(i - 1, colCG) = t(i, colCG))
If effacer Then Range("bh" & i & ":cg" & i).Delete xlShiftUp: M = M + 1
End If
Next i
MsgBox N & " ligne(s) supprimée(s) - Pas dans liste" & vbLf & vbLf & _
M & " ligne(s) supprimée(s) - Doublon XXXXXX"
End Sub