Dupliquer toutes les lignes d'un fichier Excel

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:P1" & 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

Salut frank69

Essai ça :

Sub test()
Dim drlgn, tbl, lgn
drlgn = Range("A65536").End(xlUp).Row
tbl = Range("A1:P" & drlgn)

'Attention
Range("A1:P" & drlgn).ClearContents 'Attention
'----------###########-----------

lgn = 1
For x = 1 To drlgn
For i = 1 To 16
Cells(lgn, i) = tbl(x, i)
Next
lgn = lgn + 1
If lgn Mod 2 = 0 Then x = x - 1
Next

End Sub

Bonjour,

à tester,

Sub test()
Application.ScreenUpdating = False
ligne = Cells(Rows.Count, 1).End(xlUp).Row
Range("A:A").Insert Shift:=xlToRight
Range("A1:A" & ligne).FormulaLocal = "=ligne()"
tablo = Range("A1:Q1" & ligne)
Range("A" & ligne + 1).Resize(UBound(tablo), 17) = tablo
Range("A2:Q" & Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=Range("A2"), order1:=xlAscending
Range("A:A").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

Bonjour,

et un 3ème pour la route :

Sub dup()
    Dim datas, result(), lig As Long, col As Long
    datas = [A:P].Resize(Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim result(1 To UBound(datas, 1) * 2, 1 To UBound(datas, 2))
    For lig = 1 To UBound(datas, 1)
        For col = 1 To UBound(datas, 2)
            result((lig - 1) * 2 + 1, col) = datas(lig, col)
            result((lig - 1) * 2 + 2, col) = datas(lig, col)
        Next col
    Next lig
    [A1].Resize(UBound(result, 1), UBound(result, 2)) = result
End Sub

eric

Merci beaucoup pour votre aide ! de surcroit super rapide. Merci

Ca fonctionne parfaitement et je mets en "validé".