Copier chaque ligne 3x

Kasano · 13 Février 2015

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 · 13 Février 2015

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 · 13 Février 2015

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 · 13 Février 2015

Re : Copier chaque ligne 3x

Bonsoir ,

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

Code:

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

Copier chaque ligne 3x

Kasano

XLDnaute Nouveau

camarchepas

XLDnaute Barbatruc

Kasano

XLDnaute Nouveau

camarchepas

XLDnaute Barbatruc

Discussions similaires

Copier chaque ligne 3x

Kasano

XLDnaute Nouveau

camarchepas

XLDnaute Barbatruc

Kasano

XLDnaute Nouveau

camarchepas

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency