Sub aBasLesRiches()
Dim t, n&, i&, j&, d
d = Timer
Application.ScreenUpdating = False
With Worksheets("Feuil1")
If .FilterMode Then .ShowAllData
t = .Range("a1:h" & .Cells(.Rows.Count, "g").End(xlUp).Row)
For i = 1 To UBound(t)
If t(i, 7) <> "Rich" Or t(i, 6) = "Precious Alloy" Then
n = n + 1: For j = 1 To UBound(t, 2): t(n, j) = t(i, j): Next
End If
Next i
.Range("a1:h1").Resize(UBound(t)).Clear: .Range("a1:h" & n) = t
End With
MsgBox Format(Timer - d, "0.00")
End Sub