Dupliquer toutes les lignes sur Excel

Fivel51 Messages postés 463 Date d'inscription   Statut Membre Dernière intervention   -  
titeufdu89 Messages postés 374 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

j'ai un fichier Excel avec 5000 lignes.
Chaque ligne commence en A et se termine en P. Cad il y a des infos dans chaque colonne, de A à P sur les 5000 lignes.
Actuellement les infos sont comme ceci :
Ligne 1
Ligne 2
Ligne 3

Je voudrais cela (dans le même feuillet, même fichier):
Ligne 1
Ligne 1
Ligne 2
Ligne 2
Ligne 3
Ligne 3

Cad que chaque ligne soit dupliquée et que la ligne dupliquée soit juste en dessous.

J'ai trouvé ce code sur Internet, mais ça ne fonctionne pas. Ca duplique uniquement la première ligne, mais pas la seconde et ça duplique uniquement la première colonne de la ligne (A) et pas jusqu'à la colonne P :

Sub test()
ligne = 1
tablo = Range("A1:AP" & Range("A65536").End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
For m = 1 To 2
Range("A" & ligne) = tablo(n, 1)
ligne = ligne + 1
Next
Next

End Sub



Quelqu'un pourrait-il me donner le code pour que mes 5000 lignes soient dupliquées en prenant en compte toutes les colonnes de A à P SVP ?

Merci beaucoup :)
A voir également:

3 réponses

titeufdu89 Messages postés 374 Date d'inscription   Statut Membre Dernière intervention   38
 
Bonjour,

Voici un code qui dupliquera tes lignes, en contrôlant au préalable les données des colonnes A et B, si les données sont déjà identiques sur ces deux colonnes, elle ne dupliquera par la ligne, si elles sont différentes alors la ligne sera dupliquer, à tester. Si tu as besoin de changer les colonnes contrôlées ou d'ajouter plus de colonnes dans le contrôle c'est tout à fait possible.
J'ai codé ce contrôle car sans ça à chaque exécution de la macro tes lignes seront automatiquement dupliquées, donc si par exemple tu exécute 2 fois la macro successivement tu te retrouveras avec 4 fois la ligne 1...

Sub dupliquer()
der = Range("A66536").End(xlUp).Row
For i = 1 To der * 2
    If Range("A" & i + 1).Value <> Range("A" & i).Value And Range("B" & i + 1).Value <> Range("B" & i).Value Then
    Rows(i + 1).Insert
    Rows(i).Copy Rows(i + 1)
    End If
i = i + 1
Next i
End Sub


Bonne journée

Jc
1