Option Base 1
Sub tri()
Application.ScreenUpdating = False
Dim a, b, c(), d, e
a = Feuil1.[a1].CurrentRegion.Value
b = Feuil1.[i3:L3].Value
ReDim c(UBound(a), 3)
For i = 2 To UBound(a)
If a(i, 2) > b(1, 1) Then c(i - 1, 1) = a(i, 1)
If a(i, 2) >= b(1, 2) And a(i, 2) <= b(1, 1) Then c(i - 1, 2) = a(i, 1)
If a(i, 2) < b(1, 2) Then c(i - 1, 3) = a(i, 1)
Next
With Feuil1
.[D1].CurrentRegion.ClearContents
.[D1:F1] = .[I2:K2].Value
.[D2].Resize(UBound(c), 3) = c
For d = UBound(c) To 2 Step -1
For e = 4 To 6
If IsEmpty(.Cells(d, e)) Then .Cells(d, e).Delete shift:=xlUp
Next
Next
End With
End Sub