Sub CopierInsérer()
'une ligne sur 3
Dim F As Worksheet, t1, ncol%, t2(), n&, i&, j%
Set F = Feuil1 'CodeName, à adapter
t1 = F.Range(F.UsedRange, F.UsedRange.Offset(1)) 'au moins 2 éléments
ncol = UBound(t1, 2)
ReDim t2(1 To Int(4 * UBound(t1) / 3 + 1), 1 To ncol)
n = 1
On Error Resume Next 'pour les dernières valeurs de t1
For i = 1 To UBound(t1) Step 3
For j = 1 To ncol
t2(n, j) = t1(i, j)
t2(n + 1, j) = t1(i + 1, j)
t2(n + 2, j) = t1(i + 2, j)
t2(n + 3, j) = t1(i + 2, j)
Next
n = n + 4
Next
F.UsedRange.Resize(UBound(t2)) = t2
End Sub