Si cellule active, supprimer x lignes vba

Sub SupprimerLignes()
  If ActiveCell.Interior.ColorIndex = 35 Then
    ActiveCell.EntireRow.Delete
    Do While ActiveCell.Interior.ColorIndex = 19 Or ActiveCell.Interior.ColorIndex = xlNone
      ActiveCell.EntireRow.Delete
    Loop
  End If
End Sub

Sub SupprimerLignes()
Dim xrg As Range, Asuppr As Range
  If ActiveCell.Interior.ColorIndex = 35 Then
    Set Asuppr = ActiveCell: Set xrg = ActiveCell.Offset(1)
    Do While xrg.Interior.ColorIndex = 19 Or xrg.Interior.ColorIndex = xlNone
      Set Asuppr = Asuppr.Resize(Asuppr.Rows.Count + 1)
      Set xrg = xrg.Offset(1)
    Loop
      Asuppr.EntireRow.Delete
  End If
End Sub

Sub SupprimerLignes()
Dim i
With ActiveCell
  If .Interior.ColorIndex = 35 Then
    While .Offset(i + 1) = "PRODUITS" Or .Offset(i + 1) = "Détail"
      i = i + 1
    Wend
    .Resize(i + 1).EntireRow.Delete
  End If
End With
End Sub

Sub SupprimerLignes()
Dim derlig&, i&
With ActiveCell
  If .Interior.ColorIndex = 35 Then
    derlig = Range("B" & Rows.Count).End(xlUp).Row
    While .Offset(i + 1).Interior.ColorIndex <> 35 And .Row + i < derlig
      i = i + 1
    Wend
    .Resize(i + 1).Delete xlUp
  End If
End With
End Sub

derlig = Range("B" & Rows.Count).End(xlUp).Row

derlig = Range("B" & Rows.Count).End(xlUp).Row: Msgbox derlig: End