Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Or Target.Row < 3 Or Target(1) <> "OK" Then Exit Sub
Transfert Target(1), Sheets("Sac"), 24 'colonnes A:X
Transfert Target(1), Sheets("Sac Compile"), 19 'colonnes A:S
Target(1).EntireRow.Delete
End Sub
Sub Transfert(Target As Range, feuille As Worksheet, ncol%)
Dim i&, t, rest(), j%, n&
With feuille
On Error Resume Next: .ShowAllData: On Error GoTo 0 'si la feuille est filtrée
i = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Cells(i, 1).Resize(, ncol).FormulaR1C1 = Target.EntireRow.Resize(, ncol).FormulaR1C1
.[A3].Resize(i, ncol).Sort .[F1], xlAscending, .[C1], , xlAscending, Header:=xlNo 'tri
t = .[A1].CurrentRegion.Offset(2).Resize(, ncol).FormulaR1C1
ReDim rest(1 To 3 * UBound(t), 1 To ncol)
For j = 1 To ncol: rest(1, j) = t(1, j): Next '1ère ligne
n = 1
For i = 2 To UBound(t)
n = n + 1
If Val(t(i, 6)) > Val(t(i - 1, 6)) Then n = n + 2
For j = 1 To ncol
rest(n, j) = t(i, j)
Next j, i
.[A3].Resize(n, ncol) = rest
.Columns.AutoFit 'ajustement largeur
End With
End Sub