Sub InsererLignes()
Dim t, ref, rest(), h&, i&, n&, j As Byte, k&
With [A1].CurrentRegion.Resize(, 8).Offset(1)
t = .FormulaR1C1
ref = .Columns(8)
ReDim rest(1 To UBound(t) + Application.SumIf(.Columns(8), ">0"), 1 To 8)
End With
h = UBound(t) - 1
For i = 1 To h
n = n + 1
For j = 1 To 8: rest(n, j) = t(i, j): Next
If IIf(i = h, True, ref(i + 1, 1) <> "") And ref(i, 1) > 0 Then
For k = n + 1 To n + ref(i, 1)
For j = 1 To 6
rest(k, j) = t(i, j)
Next j, k
n = n + ref(i, 1)
End If
Next i
If n Then [A2].Resize(n, 8) = rest
End Sub