Copier chaque ligne 3x

[Kasano]

Bonjour le Forum,

Aujourd'hui, je souhaiterais copier 2x la même ligne en dessous de cette dernière. Et vice et versa pour les lignes inférieurs. Soit, dans un exemple :

A1 A2 A3
1 AAA 1 4
2 BBB 2 5
3 CCC 3 6

Résultats après macro :

A1 A2 A3
1 AAA 1 4
2 AAA 1 4
3 BBB 2 5
4 BBB 2 5
5 CCC 3 6
6 CCC 3 6

Je n'ai pas su créer une macro me permettant de répéter mon action sur les cellules inférieurs de mon fichier.

Pourriez vous m'aider ?

Merci d'avance pour votre retour.

Bien cordialement,

Kasano

 

[camarchepas]

Re : Copier chaque ligne 3x

Bonjour ,

Pourquoi ne pas copier le bloc complet à la premiere ligne disponible puis faire un tri ?

Cela evite le temps d'insertion entre autre .

une autre solution peut être de mettre le bloc en variable tableau puis pour chaque ligne la copier X fois

 

[Kasano]

Re : Copier chaque ligne 3x

Merci de votre réponse rapide. Je pense avoir mal exposé mon problème. Donc, juste au cas ou je tiens à préciser que A1 A2 A3 correspond aux colonnes et 1 2 3 correspond aux lignes de mon fichier.

... Votre logique est bonne mais j'aurai souhaité une option plus pratique je dirais 😛

Merci encore !

 

[camarchepas]

Re : Copier chaque ligne 3x

Bonsoir ,

Donc 2eme solution , les valeurs à copier sont de A1 à Cxx

Sub Copie()
Dim Info() As String
Dim Tourne As Long, LigneFin As Long
Dim Plus As Long, Indice As Long

LigneFin = Range("A" & Rows.Count).End(xlUp).Row
ReDim Info(LigneFin * 2, 2)
 
Indice = -1
For Tourne = 1 To LigneFin
  For Plus = 1 To 2
    Indice = Indice + 1
    Info(Indice, 0) = Range("A" & Tourne)
    Info(Indice, 1) = Range("B" & Tourne)
    Info(Indice, 2) = Range("C" & Tourne)
  Next Plus
Next Tourne

Range("A1").Resize(Indice + 1, 2 + 1) = Info
End Sub