Changer le sens d'insertion de lignes

Bonjour

J'utilise le code ci-dessus pour insérer des lignes si la couleur de la ligne n'est pas verte ou jaune. Le truc c'est que ça m'insère des lignes au dessus des lignes éxistantes et moi je voudrais le contraire.

Sub Insert()

Dim lig As Long

Range("A5").Select

Reprise:

ActiveCell.Offset(1, 0).Select

If Len(ActiveCell) = 0 Then Exit Sub

If ActiveCell.Value <> 0 And _

ActiveCell.Interior.ColorIndex <> 6 And _

ActiveCell.Interior.ColorIndex <> 43 _

Then

ActiveCell.Rows("1:1").EntireRow.Insert Shift:=xlDown

ActiveCell.EntireRow.Interior.ColorIndex = -4142

ActiveCell.Offset(1, 0).Select

End If

GoTo Reprise

End Sub

Aidez moi Svp a changer de sens

Merci d'avance

Bonjour,

Je te conseille d'éviter, autant que possible, l'utilisation des sélections (Select) et des branchements inconditionnels (Goto).

Sub Insertions()
Dim DerLig As Long, L As Long
    With Worksheets("Feuil1")
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        For L = DerLig To 5 Step -1
            If .Range("A" & L).Interior.ColorIndex <> 6 And _
            .Range("A" & L).Interior.ColorIndex <> 43 _
            Then
                .Range("A" & L).Offset(1, 0).EntireRow.Insert Shift:=xlDown
                .Range("A" & L).Offset(1, 0).EntireRow.Interior.ColorIndex = -4142
            End If
        Next L
    End With
End Sub