Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, P As Range
Set r = [B3,K3] '1ères cellules des tableaux, à adapter
For Each r In r
With r.Resize(Rows.Count - r.Row + 1, 2)
If Not Intersect(Target, .Cells) Is Nothing Then
Application.ScreenUpdating = False
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
Set P = .Offset(, 3): .Copy P: Filtrer P, -3, ">0", xlAscending
Set P = .Offset(, 6): .Copy P: Filtrer P, -6, "<0", xlDescending
End If
End With
Next
End Sub
Sub Filtrer(P As Range, decal%, critere$, sens%)
Set P = Range(P(1), Cells(Rows.Count, P(1, 2).Column).End(xlUp))
With P.Offset(1).Columns(2)
.FormulaR1C1 = "=IF(ISNUMBER(1/(-(""""&RC[" & decal & "])" & critere & ")),RC[" & decal & "],"""")"
.Value = .Value 'supprime les formules
P.Sort .Cells, sens, Header:=xlYes 'tri
Set P = Intersect(P.Offset(1), .SpecialCells(xlCellTypeBlanks).EntireRow)
End With
P.Clear: P.Interior.ColorIndex = 2 'couleur blanche facultative...
End Sub