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

Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
- - Dernière réponse : supermajo
Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
- 23 janv. 2019 à 16:01
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
Afficher la suite 

3 réponses

Messages postés
11206
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
17 octobre 2019
1457
0
Merci
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
supermajo
Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
-
Bonsoir Via55,

Merci pour ta réponse rapide.

Je viens de tester.
Des lignes vierges se sont ajoutées, mais j'ai eu un message d'erreur

"erreur d'exécution '13'
Incompatibilité de type

et quand j'ai cliqué sur Déblocage c'est la ligne

nl = Range("D" & n) - 1

qui était en jaune.

Je ne comprends pas ce que ça veut dire.
Est-ce que c'est parce que le contenu des cellules des colonnes ne se sont pas dupliqués ?

Encore merci pour ton aide précieuse.

Cdlt
supermajo
Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
-
Bonjour

Voici le lien vers le fichier.

https://www.cjoint.com/c/HLrlHRU3BEz

La colonne D est en format standard...
Faut-il la mettre en format nombre ?

Merci encore
via55
Messages postés
11206
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
17 octobre 2019
1457 -
Re

Le bug vient simplement de la ligne de titre qui bien sur n’est pas un nombre
Il suffit de modifier la ligne de macro
For n = Ligne To 1 Step -1
en
For n = Ligne To 2 Step -1

Pas besoin de modifier le format de la colonne

Cdlmnt
Via
supermajo
Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
-
Merci beaucoup via55.
Bien cordialement
Commenter la réponse de via55
Messages postés
11206
Date d'inscription
mercredi 16 janvier 2013
Statut
Membre
Dernière intervention
17 octobre 2019
1457
0
Merci
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
Commenter la réponse de via55
Messages postés
371
Date d'inscription
samedi 28 juillet 2012
Statut
Membre
Dernière intervention
4 mars 2019
30
0
Merci
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
titeufdu89
Messages postés
371
Date d'inscription
samedi 28 juillet 2012
Statut
Membre
Dernière intervention
4 mars 2019
30 -
Bonjour,

Essaye ce code, par contre il faut insérer un colonne en colonne D pour passer les informations de ta colonne D actuelle en colonne E :

Sub duplique()
der = Range("A65536").End(xlUp).Row + 1
For i = 2 To der
MsgBox i
    If Range("E" & i) > 1 Then
    eti = Range("A" & i).Value
    mag = Range("B" & i).Value
    sam = Range("C" & i).Value
    nbr = Range("E" & i).Value
    Range("D" & i) = 1
        For j = i + 1 To i + nbr - 1
            If Range("A" & j).Value = eti And Range("B" & j).Value = mag And Range("C" & j).Value = sam Then
            Range("D" & j) = Range("D" & j - 1) + 1
            Range("E" & j) = nbr
            Else
            Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
            Range("A" & j) = eti
            Range("B" & j) = mag
            Range("C" & j) = sam
            Range("D" & j) = Range("D" & j - 1) + 1
            Range("E" & j) = Range("E" & i).Value
            der = der + 1
            End If
        Next j
    i = i + nbr - 1
    End If
Next i
End Sub


Bonne journée

Jc
michel_m
Messages postés
15934
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 octobre 2019
2811 -
Salut Titeuf

Vu le nombre de lignes, il serait peut-être intéressant de bloquer le défilement de l'écran (confort de yeux , rapidité) par ce thread en début de procédure

Application.screenupdating=False

pas la peine de remettre à True à la fin
titeufdu89
Messages postés
371
Date d'inscription
samedi 28 juillet 2012
Statut
Membre
Dernière intervention
4 mars 2019
30 -
Salut Michel,

Effectivement, c'est plus confort, merci de l'info!

Après un second test le code n'était pas tout a fait opérationnel, en voici un second qui devrait être plus pertinent... à tester :
Sub duplique()
Application.ScreenUpdating = False
der = Range("A65536").End(xlUp).Row + 1
For n = 2 To Range("A65536").End(xlUp).Row
    For i = 2 To der
        If Range("E" & i) > 1 Then
        eti = Range("A" & i).Value
        mag = Range("B" & i).Value
        sam = Range("C" & i).Value
        nbr = Range("E" & i).Value
        Range("D" & i) = 1
            For j = i + 1 To i + nbr - 1
                If Range("A" & j).Value = eti And Range("B" & j).Value = mag And Range("C" & j).Value = sam Then
                Range("D" & j) = Range("D" & j - 1) + 1
                Range("E" & j) = nbr
                Else
                Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                Range("A" & j) = eti
                Range("B" & j) = mag
                Range("C" & j) = sam
                Range("D" & j) = Range("D" & j - 1) + 1
                Range("E" & j) = Range("E" & i).Value
                der = der + 1
                End If
            Next j
        i = j - 1
        End If
    Next i
Next n
End Sub


Bonne soirée

Jc
supermajo
Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
-
Merci bcp JC.
Je teste ça demain matin et te tiens au courant.
Bonne soirée ou plutôt bonne nuit.
supermajo
Messages postés
15
Date d'inscription
dimanche 16 décembre 2018
Statut
Membre
Dernière intervention
19 mars 2019
-
Bonjour JC,

BRAVO.
C'est vraiment super.
Un grand merci.

J.E.
Commenter la réponse de titeufdu89