Microsoft 365 Dupliquer automatiquement lignes

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

thr92

XLDnaute Nouveau
Bonjour,

J'ai cet immense tableau à travailler et je cherche une solution moins chronophage pour y arriver. Il faut que je duplique chaque lignes autant que de nombre à partir de la colonne AA.

Exemple : dupliquer la ligne A2:Y2 7 fois et faire apparaitre successivement en colonne Z les numéros de semaines
1ere duplication : ligne A2:Y2 43, 2ème ligne A2:Y2 44 etc etc...

Si quelqu'un a une solution à ça, je suis preneuse !

Merci par avance et bonne semaine

P.S : j'ai dû supprimer des lignes pour pouvoir vous joindre le fichier mais j'ai à peu près 3300 lignes à traiter
 

Pièces jointes

Avec power query ?
edit : oops, fichier trop volumineux du coup et explications
j'ai ajouté A:H au premier tableau,puis power query (obtenir des données depuis un tableau)
Selectionné A:Z, Dépivoter les autres colonnes
supprimé la colonne attribut, puis renommé la colonne valeurs en semaine
 

Pièces jointes

Dernière édition:
Bonjour à tous

C'est typiquement ce qu'on fait en quelques clics avec PowerQuery intégré à ta version Excel

Il manque cependant des infos : d'où vient le tableau ? D'un copier coller manifestement et ensuite quel est la finalité pour être sûr d'adopter la bonne approche...

EDIT : st007 : tu as posté l'original
 
Bonjour Thr, St, Fanch, Chris,
Un essai en PJ.
Mais le feuil1 contient tellement de mise en forme et MFC que l'utiliser pour dupliquer les lgnes est vraiment trop long.
Donc en PJ je crée une nouvelle feuille appelée Dupliqué, mais malgré ça pour 2093 lignes, sur mon PC cela génère 16600 lignes en 138s soit plus de 2min. Avec :
VB:
Sub Duplique()
    Dim T0, F, Lig, L, N, Nb
    T0 = Timer
    Cells.ClearContents
    Application.ScreenUpdating = False
    Set F = Sheets("Feuil1")            ' A modifier suivant nom feuille BDD
    ActiveWorkbook.Save
    Lig = 2
    DL = F.Range("A65500").End(xlUp).Row
    Range("A1:Y1") = F.Range("A1:Y1").Value ' Copie des titres
    For L = 2 To DL
        Application.StatusBar = "Progression : " & L & " sur " & DL
        N = Application.CountIf(F.Range(F.Cells(L, "AA"), F.Cells(L, "CA")), ">0")
        Range("A" & Lig & ":Y" & Lig + N - 1) = F.Range("A" & L & ":Y" & L).Value ' Copier Coller valeurs
        For Nb = 1 To N ' Ajout des N°
            Cells(Lig + Nb - 1, "Z") = F.Cells(L, 26 + Nb)
        Next Nb
        Lig = Lig + N
    Next L
    Hmin
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
    MsgBox "Temps d'éxécution : " & Int(Timer - T0) & "s"
End Sub
 

Pièces jointes

Bonjour à tous,

Pour le fun, une autre méthode très rapide. Le code est dans module1.
Cliquez sur le bouton Dupliquer. Environ 1,6 seconde pour 3500 lignes de données source.
VB:
Sub Dupliquer()
Dim t, der&, i&, j&, n&, k&, debut
   debut = Timer
   With Sheets("Feuil1")      'lecture données source dans tableau t
      If .FilterMode Then .ShowAllData
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      t = .Range("a1:bx1").Resize(der)
   End With
   ReDim res(1 To 48 * UBound(t), 1 To 26)   'tableau résultat
   'recopie des en-têtes
   n = 1: For j = 1 To 26: res(n, j) = t(n, j): Next
   'duplications des autres lignes
   For i = 2 To UBound(t)
      For j = 27 To 74
         t(i, j) = Int(Val(Trim(t(i, j))))
         If t(i, j) > 0 Then
            n = n + 1: res(n, 26) = t(i, j)
            For k = 1 To 25: res(n, k) = t(i, k): Next
         End If
      Next j
   Next i
   'résultat sur feuille "Duplication"
   With Sheets("duplication")
      .Columns("a:z").ClearContents
      .Range("a1").Resize(n, UBound(res, 2)) = res
      .Select
   End With
   MsgBox "Résultat : " & Format(n - 1, "#,##0") & " lignes de données" & vbLf & vbLf & _
         "Durée d'exécution : " & Format(Timer - debut, "0.0\ sec.")
End Sub
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
2
Affichages
720
Réponses
4
Affichages
1 K
Réponses
5
Affichages
598
G
Réponses
14
Affichages
2 K
Réponses
5
Affichages
2 K
Retour