Autres dupliquer automatiqument des lignes

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NT() As Variant 'déclare la variable NT (Nouveau Tableau)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)

Set O = Worksheets("Feuil1") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
ReDim NT(1 To UBound(TV) * 4, 1 To 3) 'dimensionne le nouveau tableau NT
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tablerau des valeurs TV
    For J = 1 To 4 'boucle 2 : sur 4 lignes
        NT(K + J, 1) = TV(I, 1) 'récupère dans la ligne K+J, colonne 1 de NT la donnée ligne I colonne 1 de TV
        NT(K + J, 2) = TV(I, 2) 'récupère dans la ligne K+J, colonne 2 de NT la donnée ligne I colonne 2 de TV
        NT(K + J, 3) = TV(I, 3) 'récupère dans la ligne K+J, colonne 1 de NT la donnée ligne I colonne 3 de TV
    Next J 'prochaine
    K = K + 4 'incrémente K
Next I 'prochaine ligne de la boucle 1
O.Range("A1").Resize(UBound(NT, 1), 3) = NT 'renvoie le tableau NT dans A1 redimensionnée
End Sub