XL 2013 inserer une ligne suivant critere

Lolote83 à dit:

Bonjour,
Peut être comme ceci

Code:

Sub TEST()
    Application.ScreenUpdating = False
    xRef = [A2]
    xDerLig = Range("A1000").End(xlUp).Row
    For Each xCell In Range("A2:A" & xDerLig)
        If xCell.Value <> xRef Then
            xRef = xCell.Value
            xLig = xCell.Row
            Rows(xLig & ":" & xLig).Insert Shift:=xlDown
            xDerLig = Range("A1000").End(xlUp).Row
        End If
    Next xCell
    Application.ScreenUpdating = True
End Sub

@+ Lolote83

Cliquez pour agrandir...