Supprimer des lignes en fonction d'une partie de la valeur

bonjour,

j'ai fait une macro pour supprimer d'un fichier les lignes qui ne m'intéressent pas en fonction d'une partie de la valeur de la cellule :

Sub SupprimerLignes()

Dim rcel As Range

Application.ScreenUpdating = False

Range("R6").Select

Range(Selection, Selection.End(xlDown)).Select

For Each rcel In Selection

If Left(rcel.Value, 3) = "1.1" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "1.4" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "2.2" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "2.3" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "2.5" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "3.1" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "3.2" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "3.3" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "3.4" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "4.1" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "4.2" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "4.4" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "5.1" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "5.2" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "5.3" Then

rcel.EntireRow.Delete

ElseIf Left(rcel.Value, 3) = "7.2" Then

rcel.EntireRow.Delete

End If

Next rcel

End Sub

lors de l'application de la macro toutes les lignes concernées ne sont pas supprimées. J'ai dans un premier temps rajouter une boucle avec un compteur <10 pour être sûr que toutes les valeurs sont bien supprimées mais cette solution ne me plait pas.

je cherche donc une solution pour que la macro s'applique dès la première fois.

Est-il possible de simplifier le code ?

merci

Bonjour

Quand on supprime des lignes il vaut mieux commencer par la fin et remonter

A tester

Sub SupprimerLignes()
Dim J As Long
  For J = Range("R" & Rows.Count).End(xlUp).Row To 6 Step -1
    Select Case Left(Range("R" & J), 3)
      Case "1.1", "1.4", "2.2", "2.3", "2.5", "3.1", "3.2", "3.3", "3.4", "4.1", "4.2", "4.4", "5.1", "5.2", "5.3", "7.2"
        Rows(J).Delete
    End Select
  Next J
End Sub

Si des soucis, ton fichier sera souhaitable

Merci beaucoup Banzai64

ça marche impeccable.