Supprimer le même nombre de ligne automatiquement

Bonjour,

Voilà ma macro actuellement supprime la ligne de la cellule qui a été trouvé en doublon mais j'aimerais que ce ne soit pas que la ligne de la cellule correspondante qui soit supprimée mais aussi les 16 lignes suivantes. Est-ce quelqu'un pourrait me venir en aide ?

Voici le code:

Sub Doublon2()

    Dim Plage As Range
    Dim Cel As Range

    With Worksheets("Sheet1")

    'en colonne "A" à partir de A2 'en colonne "C" à partir de C20
       Set Plage = .Range(.Cells(20, 3), .Cells(150, 3))

    End With

    'boucle la plage de la feuille "Compte" et cherche chaque valeur
   'en correspondance exacte dans la plage de la feuille "Source"
   For Each Cel In Plage

        If Application.CountIf(Plage, Cel.Value) > 1 And Left(Cel.Value, 2) = "ns" Then

            'MsgBox "Attention, la valeur '" & Cel.Value & "' est en doublon," _
                   '& " veuillez éliminer manuellement le double situé en '" & Cel.Address(0, 0) _
                   '& "' avant de pouvoir exporter les données !"

            Cel.EntireRow.Delete

        End If

    Next Cel

End Sub

Merci beaucoup,

Marion

Bonjour

Sans fichier... essayez en remplaçant

Cel.EntireRow.Delete

par

Rows(Cel.Row & ":" & Cel.Row + 16).Delete

Cordialement

Bonjour marions1857, Dan, le forum,

A tester ....

Cel.Resize(17).EntireRow.Delete

Cordialement,

@+Dan

Bonjour Dan ca fonctionne parfaitement merci beaucoup :)

Ok.

Cordialement