Ajouter des lignes en fonction de la valeur d'une cellule. Résolu/Fermé

Question

Bonjour,

J'ai un fichier de plusieurs milliers de lignes.

Dans la cellule D2, il y a un nombre qui indique le nombre de lignes - 1, que je dois dupliquer.
Exemple :
s'il y a 3, Excel doit dupliquer 2 fois la ligne.
S'il y a 5, il doit dupliquer 4 fois la ligne, etc.......

Je ne sais pas faire une macro.
Est-ce que quelqu'un peut m'aider ?
Merci bcp

via55 · Answer

Bonjour supermajo

Onglet Developpeur - Visual basic (ou ALT + F11) pour ouvrir l'éditeur VBA
Insertion - Module puis copier coller la macro suivante dans la page et fermer l'éditeur
Sub ajout()

Dim Ligne As Long
Ligne = Columns(4).Find("*", , , , xlByColumns, xlPrevious).Row
For n = Ligne To 1 Step -1
nl = Range("D" & n) - 1
If nl > 0 Then
For x = 1 To nl
Rows(n + 1 & ":" & n + 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next
 End If
 Next
End Sub 
Onglet Developpeur - Macris - Selctionner ajout puis Executer

Cdlmnt
Via

via55 · Answer

C'est sans doute que dans une ligne en D au lieu d'avoir un nombre il y a du texte ou autre
Impossible d'en dire sans voir ton fichier
Poste un exemple de ton fichier sur cjoint.com, fais créer un lien que tu copies et reviens coller ici

titeufdu89 · Answer

Bonsoir, 

Voici un code qui te dupliquera tes lignes le nombre de fois désiré (saisi en colonne D)
mais en contrôlant avant le nombre de fois ou la ligne est déjà présente (en analysant les colonnes de A à C). C'est à dire que si ta ligne à déjà été dupliquée lors d'une première éxécution de la macro elle ne la redupliquera pas, ou si besoin juste la quantité manquante.  

Option Explicit
Sub maj()
Dim i, j, k, n, der As Long
Dim cpte, dif, nbr As Integer
Dim marque, nom, taille, px As String
der = Range("A65536").End(xlUp).Row
For n = 2 To der
    For i = 2 To der
        If Range("D" & i) > 1 Then
        cpte = 0
        nbr = Range("D" & i).Value
        marque = Range("A" & i).Value
        nom = Range("B" & i).Value
        taille = Range("C" & i).Value
            Do While Range("A" & i).Offset(cpte, 0) = marque And Range("B" & i).Offset(cpte, 0) = nom And Range("C" & i).Offset(cpte, 0) = taille
            Range("D" & i).Offset(cpte, 0) = Range("D" & i).Value
            cpte = cpte + 1
            Loop
            i = i + cpte - 1
                If cpte < nbr Then
                dif = nbr - cpte
                    Do While dif > 0
                    Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    Rows(i).Copy Rows(i + 1)
                    Application.CutCopyMode = False
                    i = i + 1
                    dif = dif - 1
                    der = der + 1
                    Loop
                End If
        End If
    Next i
Next n
End Sub
 
Bonne soirée 

Jc

Ajouter des lignes en fonction de la valeur d'une cellule.

3 réponses

Discussions similaires