Sub InsererLignes()
Dim n As Byte, plage As Range, tablo1
Dim ub1&, ub2%, tablo2(), i&, m As Byte, p&, j%
n = 11 'nombre de lignes identiques, à adapter
If Application.CountA([A:D]) < 2 Then Exit Sub 'colonnes à étudier
Set plage = Intersect([A:D], ActiveSheet.UsedRange)
tablo1 = plage 'un tableau est plus rapide
ub1 = (n + 1) * UBound(tablo1)
If plage.Row + ub1 - 1 > Rows.Count Then _
MsgBox "Nombre de lignes trop grand !", 48: Exit Sub
ub2 = UBound(tablo1, 2)
ReDim tablo2(1 To ub1, 1 To ub2)
For i = 1 To ub1
m = i Mod (n + 1)
If m = 1 Then p = p + 1
If m Then
For j = 1 To ub2
tablo2(i, j) = tablo1(p, j)
Next
End If
Next
plage.Resize(ub1) = tablo2
End Sub