Discussion :

[lucky32]

Bonjour à toutes et à tous,

Je vous contacte parce que je galère un peu.

j'ai une liste de produits référencés par les groupes de lettre comme: "AN" , "CD" etc
donc dans la colonne A, il y a ces codes produit. Lorsque le trouve, dans cette colonne deux fois de suite (l'un sous l'autre) le produit "AN", je dois insérer une ligne au dessus du premier. il faut savoir que cette liste comporte 19857 lignes!...
est-il possible de faire une macro en ce sens?
je joins un exemple de la liste où j'ai mis en gras les cellules consernées et une fonction que j'ai créé en colonne "K" qui m'ndique où je dois insérer une ligne vide !....
Merci par avance.
lucky32

[gFZT82]

Bonjour,

Une solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Sub Test()
Dim LigneDebut As Byte
Dim DerLigne As Long, i As Long
Dim Flag As Boolean
    Application.ScreenUpdating = False
    With Worksheets("StatMoisIP201207")
        LigneDebut = 5
        DerLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = DerLigne To LigneDebut Step -1
            If .Range("A" & i) = "AN" Then
                If Flag = True Then
                    .Range("A" & i).EntireRow.Insert Shift:=xlShiftDown
                    Flag = False
                Else
                    Flag = True
                End If
            Else
                Flag = False
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Cordialement.

[lucky32]

Merci gFZT82, le code est parfait
amicalement
lucky32

[mercatog]

Si tu veux insérer une ligne en dessus de chaque bloc de plus de 2 "AN" en colonne A (et pas seulement 2)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Test()
Dim DerLigne As Long, i As Long
Dim LigneDebut As Byte
Dim k As Integer
 
Application.ScreenUpdating = False
With Worksheets("StatMoisIP201207")
    LigneDebut = 4
    DerLigne = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = DerLigne To LigneDebut Step -1
        If .Range("A" & i) = "AN" Then
            k = k + 1
        Else
            If k > 1 Then .Rows(i + 1).Insert Shift:=xlShiftDown
            k = 0
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

[lucky32]

Bonsoir,
Merci aussi à mercatorg pour cette macro qui fonctionne aussi super bien
Trés amicalement.
Lucky32