Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, n&, j%
tablo = Feuil1.UsedRange.Resize(, 17) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 10)
For i = 2 To UBound(tablo)
If Not tablo(i, 7) Like "*Sans*impact*" And Not tablo(i, 9) Like "*Source*Batmain*" And tablo(i, 10) Like "*PRODUCTION*" Then
n = n + 1
resu(n, 1) = tablo(i, 1)
resu(n, 2) = tablo(i, 2)
For j = 3 To 9
resu(n, j) = tablo(i, j + 1)
Next
resu(n, 10) = tablo(i, 16)
End If
Next
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'à adapter
If n Then
.Resize(n, 10) = resu
.Resize(n, 10).Sort .Cells(1, 4), xlAscending, .Cells(1, 6), , xlAscending, Header:=xlNo
End If
.Offset(n).Resize(Rows.Count - .Row - n + 1, 10).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub