Sub Effacer()
Dim cell As Range
For Each cell In Range("D5:D24")
If cell.Value <> "EGUILLES" Then cell.Value = ""
Next
End Sub
Sub Test_OK()
Dim f As Range
Application.ScreenUpdating = False
ActiveSheet.Range("$A$4:$F$24").AutoFilter Field:=4, Criteria1:="<>EGUILLES", Operator:=xlAnd
Set f = Range("_FilterDataBase")
f.Offset(1, 0).Resize(f.Rows.Count - 1).SpecialCells(12).Delete Shift:=xlUp
ActiveSheet.ShowAllData
ActiveSheet.AutoFilterMode = False
End Sub
Sub Test_OK2()
Dim f As Range
Application.ScreenUpdating = False
ActiveSheet.Range("$A$4:$F$24").AutoFilter Field:=4, Criteria1:="<>EGUILLES", Operator:=xlAnd
Set f = Range("_FilterDataBase")
f.Columns(4).Offset(1, 0).Resize(f.Rows.Count - 1).SpecialCells(12) = Empty
ActiveSheet.ShowAllData
ActiveSheet.AutoFilterMode = False
End Sub
Sub Test_OK3()
Dim f As Range
Application.ScreenUpdating = False
ActiveSheet.Range("$A$4:$F$24").AutoFilter Field:=4, Criteria1:="<>EGUILLES", Operator:=xlAnd
Set f = Range("_FilterDataBase")
f.Columns(4).Offset(1, 0).Resize(f.Rows.Count - 1).SpecialCells(12) = Empty
f.Columns(6).Offset(1, 0).Resize(f.Rows.Count - 1).SpecialCells(12) = Empty
ActiveSheet.ShowAllData
ActiveSheet.AutoFilterMode = False
End Sub
Certes, mais (petit cachottier), tu ne nous l'avais pas indiqué que tu avais fait toi-même la modif du code proposé par Laurent78C'est parfait !
Pour ma part, j'avais repris le code de Laurent
et "Range(D5:F24)".