Sub Insertion_Tableaux()
Dim P As Range, t, ub&, jours, rest(), i&, n&, j%, ok As Boolean
Set P = Intersect(Range("A10:k" & 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), , xlAscending, P(1, 7), Header:=xlNo 'tri sur les dates
t = P.Resize(P.Rows.Count + 1).FormulaR1C1 'tableau des formules
ub = UBound(t) - 1
jours = P.Resize(P.Rows.Count + 1).Columns(7) 'au moins 2 cellules
ReDim rest(1 To ub + Application.CountIf(P.Columns(7), ">=90"), 1 To 7) ' ceci ">=90" à modifier si changement de la periode sans malus
'---création du tableau rest---
For i = 1 To ub
n = n + 1
For j = 1 To 11
'*********************************
rest(n, j) = t(i, j)
'*********************************
Next j
ok = True
For j = i + 1 To ub 'si plusieurs lignes de même nom et même date
If t(j, 1) <> t(i, 1) Or t(j, 2) <> t(i, 2) Then Exit For
If t(i + 1, 3) = "Bonus période longue sans malus" Then ok = False: Exit For
Next j
If Val(jours(i, 1)) >= Sheets("data").Range("g11").Value And ok Then
n = n + 1 'ligne ajoutée
rest(n, 1) = t(i, 1)
rest(n, 2) = Date 't(i, 2) 'même date
rest(n, 3) = "Bonus période longue sans malus"
rest(n, 4) = t(i, 4) 'copie la formule en colonne D
rest(n, 5) = t(i, 5) 'copie la formule en colonne e
rest(n, 6) = t(i, 6) 'copie la formule en colonne f
rest(n, 7) = t(i, 7) 'copie la formule en colonne g
rest(n, 9) = t(i, 9) 'copie la formule en colonne i
rest(n, 10) = t(i, 10) 'copie la formule en colonne j
rest(n, 11) = t(i, 11) 'copie la formule en colonne k
End If
Next i
'---restitution---
Application.DisplayAlerts = False 'facultatif, s'il y a des liaisons avec un classeur inconnu...
P.Resize(n).FormulaR1C1 = rest
End Sub
