Création de X lignes par rapport à une cellule [résolu]

Sub InsereLignesApres()
Dim i&, c As Range
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c(2).Resize(CInt(c)).EntireRow.Insert
Next
End Sub

Sub InsereLignesAvant()
Dim i&, c As Range
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c.Resize(CInt(c)).EntireRow.Insert
Next
End Sub

Sub InsereLignesApres()
Dim i&, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'sécurité
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c(2).Resize(CInt(c)).EntireRow.Insert
Next
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub InsereLignesApres()
Dim i&, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Application.Calculation = xlCalculationManual
On Error Resume Next 'sécurité
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c(2).Resize(CInt(c)).EntireRow.Insert
Next
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub InsereLigneTableau()
Dim deb As Range, ncol%, derlig&, P As Range, t, tref, rest(), i&, n&, j%
Set deb = [A9:BL9] '1ère ligne du tableau
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
Set P = deb.Resize(derlig - deb.Row + 1)
t = P.FormulaR1C1
tref = P.Columns(ncol).Value 'colonne de référence
ReDim rest(1 To P.Rows.Count + Application.Sum(tref), 1 To ncol)
For i = 1 To P.Rows.Count
  n = n + 1
  For j = 1 To ncol
    rest(n, j) = t(i, j)
  Next
  n = n + tref(i, 1)
Next
deb.Resize(n, ncol) = rest
End Sub

Sub InsereLignes()
Dim duree, deb As Range, ncol%, derlig&, P As Range, rc&, t, tref, rest(), i&, n&, j%
duree = Timer
Set deb = [A9:BL9] '1ère ligne du tableau
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
Set P = deb.Resize(derlig - deb.Row + 1)
rc = P.Rows.Count
t = P.FormulaR1C1
tref = P.Columns(ncol).Value 'colonne de référence
'---tableau des résultats---
ReDim rest(1 To rc + Application.Sum(tref), 1 To ncol)
For i = 1 To rc
  n = n + 1
  For j = 1 To ncol
    rest(n, j) = t(i, j)
  Next
  n = n + tref(i, 1)
Next
Application.EnableEvents = False ' si macros évènementielles
Application.Calculation = xlCalculationManual 'si formules volatiles dans le classeur
'---suppression des formules---
P = P.Value
'---insertion réelle de lignes---
For i = rc To 1 Step -1
  P(i + 1, 1).Resize(tref(i, 1)).EntireRow.Insert
  Application.StatusBar = "Réalisé " & Int(100 * (rc - i + 1) / rc) & " %" _
    & " - Lignes restantes " & i - 1
Next
'---restitution des formules---
deb.Resize(n, ncol) = rest
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Durée " & Format(Timer - duree, "0.00 \s")
End Sub