Sub Insertion_Tableaux()
Dim P As Range, t, ref, rest(), d As Object, i&, n&, j%
Set P = Intersect(Range("A10:G" & Rows.Count), ActiveSheet.UsedRange.EntireRow)
If P Is Nothing Then Exit Sub
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
P.Sort P(1, 2), xlAscending, , P(1), , P(1, 7), Header:=xlNo 'tri sur les dates
t = P.Resize(P.Rows.Count + 1).FormulaR1C1 'tableau des formules
ref = P.Resize(P.Rows.Count + 1).Columns(7) 'au moins 2 cellules
ReDim rest(1 To UBound(t) + Application.CountIf(P.Columns(7), "ok"), 1 To 7)
'---détermination des lignes à traiter (dernier malus ok)---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t) - 1
If ref(i, 1) = "ok" And t(i + 1, 3) <> "Bonus + de 90 jours" Then d(t(i, 1)) = i
Next
'---création du tableau rest---
For i = 1 To UBound(t) - 1
n = n + 1
For j = 1 To 7
rest(n, j) = t(i, j)
Next
If i = d(t(i, 1)) Then
n = n + 1 'ligne ajoutée
rest(n, 1) = t(i, 1)
rest(n, 2) = t(i, 2)
rest(n, 3) = "Bonus + de 90 jours"
rest(n, 4) = t(i, 4) 'copie de la formule en colonne D
End If
Next
'---restitution---
Set P = P.Resize(n)
P.Rows(1).AutoFill P, xlFillFormats 'copie les formats
Application.DisplayAlerts = False 'facultatif, s'il y a des liaisons avec un classeur inconnu...
P.FormulaR1C1 = rest
End Sub