Ajout de lignes vides avec conditions

Option Explicit

Sub InsertionLigne()
Dim EnCours As String
Dim Ligne As Long
Dim I As Integer
Dim Suites

  Suites = Array("Test1", "Test2", "Test3", "Test4")
  Application.ScreenUpdating = False
  Ligne = 1
  Do While Range("A" & Ligne) <> ""
    EnCours = Left(Range("A" & Ligne), InStr(1, Range("A" & Ligne), " -") + 2)
    For I = 0 To UBound(Suites)
      If Range("A" & Ligne) <> EnCours & Suites(I) Then
        Rows(Ligne).Insert
      End If
      Ligne = Ligne + 1
    Next I
  Loop
  Application.ScreenUpdating = True
End Sub