XL pour MAC insérer une ligne qui copie la précédente à chaque changement de valeur

[herve30]

Bonjour,
Je souhaite insérer une ligne qui copie la précédente à chaque changement de valeur
Je fais pour ajouter la ligne :

Sub insérer()
Dim Ligne As Long

For Ligne = Range("A1").End(xlDown).Row To 2 Step -1
If Range("A" & Ligne) <> Range("A" & Ligne - 1) Then
Range("A" & Ligne).EntireRow.Insert
End If
Next
End Sub

Mais je n'arrive pas à modifier pour copier la ligne précédente !
Merci d'avance
Cordialement

 

[sylvanu]

Bonjour Hervé,
Si j'ai bien compris, essayez :

Sub insérer()
    Dim Ligne As Long
    For Ligne = Range("A1").End(xlDown).Row To 2 Step -1
        If Range("A" & Ligne) <> Range("A" & Ligne - 1) Then
            Range("A" & Ligne).EntireRow.Insert
            Rows(Ligne + 1).Copy Rows(Ligne)
        End If
    Next
End Sub

 

[herve30]

Bonjour,
Merci pour ta réponse sylvanu ,
Le code ajoute bien une ligne au dessus en reprenant la ligne du dessous
Mais j'aimerai limiter cet ajout pour les lignes qui ont la même référence
Voir la PJ
Cordialement

 

[sylvanu]

Bonjour Hervé,
J'ai un peu de mal à comprendre entre les deux demandes :

Je souhaite insérer une ligne qui copie la précédente à chaque changement de valeur

Donc 12345 doit être dupliquée puisqu'ensuite il y a 5678.

Mais j'aimerai limiter cet ajout pour les lignes qui ont la même référence

12345 n'est pas dupliquée dans votre exemple alors qu'ensuite on trouve 5678.
Vous pouvez être plus précis ?
Tentative :
Une ligne est dupliqué que si on a un changement de référence ET que les lignes suivantes ont une même référence.

 

[herve30]

Bonjour,
Désolé si je me suis mal fait comprendre .
Vous dites :
Tentative :
Une ligne est dupliqué que si on a un changement de référence ET que les lignes suivantes ont une même référence.
Oui c'est bien çà !
Petite explication:
Dans le fichier joint on voit:
En A2 12345 est une Réf unique donc la ligne n'est pas dupliqué
idem pour toutes les Réf uniques (A12-151617, A13-181920 ... )
En A3 5678 a des Réf multiples (en A4) on ajoute donc une ligne au dessus de A3
qui duplique le contenu de la ligne du dessous
Idem pour la Réf A5 91011 et en A8 121314

J’espère être un peu plus clair
Je reste à vote disposition
Cordialement

 

[mapomme]

Bonjour à tous

Attention! C'est une macro qui ne doit être exécutée qu'une fois car on modifie les données sources.
Si vous le désirez, on pourrait afficher le résultat sur une autre feuille afin de préserver les données initiales.

Essayer ce code dans le module de la feuille "Feuill1":

Sub dupliquer()
Dim der&, ref, n&, i&
   Application.ScreenUpdating = False
   With ActiveSheet
      If .FilterMode Then .ShowAllData
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      For i = der To 1 Step -1
         If .Cells(i, "a") = ref Then
            n = n + 1
         Else
            If n > 1 Then
               .Rows(i + 1).Insert
               .Rows(i + 2).Copy Rows(i + 1)
            End If
            ref = .Cells(i, "a")
            n = 1
         End If
      Next i
   End With
End Sub

 

[herve30]

Rebonjour mapomme ,
SUPER !
C'est exactement ce qu'il me fallait
Qu'entendez-vous par :
On pourrait afficher le résultat sur une autre feuille afin de préserver les données initiales ?
C'est intéressant .

Cordialement