Macro gestion des doublons

Bonjour à tous,

En cherchant sur internet une solution pour traiter des doublons dans un fichier excel, je suis tombé sur cet outil qui me correspond à 90% :

Sub doublons_et_lignes_vides()

    'Macro : Sébastien Mathier - Excel-Pratique.com
    'A propos de cette macro : http://www.blog-excel.com/gerer-doublons-et-lignes-vides/

    choix = InputBox("Avant d'utiliser cet outil, n'oubliez pas d'enregistrer votre fichier !" & Chr(10) & Chr(10) & "Choisissez l'action qui vous intéresse :" & Chr(10) & Chr(10) & "1. Colorer les doublons (colorer la cellule)" & Chr(10) & "2. Colorer les doublons (colorer la ligne entière)" & Chr(10) & "3. Effacer les doublons (en laissant la ligne vide)" & Chr(10) & "4. Supprimer les doublons (ligne entière)" & Chr(10) & "5. Supprimer les lignes vides" & Chr(10) & Chr(10) & "Entrez le n° de l'action et cliquez sur OK :", "Gestion des doublons - Blog-Excel.com")
    If choix = "" Then Exit Sub

    choix2 = ""
    If choix = 1 Or choix = 2 Or choix = 3 Or choix = 4 Then choix2 = InputBox("Entrez la lettre de la colonne où les doublons doivent être recherchés :", "Gestion des doublons - Blog-Excel.com")
    If choix = 5 Then choix2 = InputBox("Entrez la lettre de la colonne à prendre en compte (si la cellule de cette colonne est vide, la ligne sera supprimée) :", "Gestion des doublons - Blog-Excel.com")
    If choix2 = "" Then Exit Sub

    Application.ScreenUpdating = False
    test = Timer

    der_ligne = Range(choix2 & "65000").End(xlUp).Row

    Dim tab_cells()
    ReDim tab_cells(der_ligne - 1)

    For Ligne = 1 To der_ligne
        tab_cells(Ligne - 1) = Range(choix2 & Ligne)
    Next

    Nb = 0
    If choix = 4 Or choix = 5 Then Compteur = 0

    For Ligne = 1 To der_ligne
        Contenu = tab_cells(Ligne - 1)

        If (choix = 1 Or choix = 2) And Contenu <> "" Then 'Colorer doublons
            For I = 1 To der_ligne
                If Contenu = tab_cells(I - 1) And Ligne <> I Then 'Si doublon
                    Nb = Nb + 1
                    If choix = 1 Then
                        Range(choix2 & Ligne).Interior.ColorIndex = 3
                    Else
                        Range(Ligne & ":" & Ligne).Interior.ColorIndex = 3
                    End If
                    Exit For
                End If
            Next
        End If

        If (choix = 3 Or choix = 4) And Ligne > 1 And Contenu <> "" Then 'Effacer/supprimer doublons
            For I = 1 To Ligne - 1
                If Contenu = tab_cells(I - 1) Then 'Si doublon
                    Nb = Nb - 1
                    If choix = 3 Then
                        Range(Ligne - 1 & ":" & Ligne - 1).ClearContents

                    Else
                        Range(Ligne + Compteur & ":" & Ligne + Compteur).Delete
                        Compteur = Compteur - 1
                    End If
                    Exit For
                End If
            Next
        End If

        If choix = 5 And Contenu = "" Then 'Lignes vides
            Range(Ligne + Compteur & ":" & Ligne + Compteur).Delete
            Compteur = Compteur - 1
            Nb = Nb + 1
        End If
    Next

    res_test = Format(Timer - test, "0" & Application.DecimalSeparator & "000")
    Application.ScreenUpdating = True

    If Nb = 0 And choix = 5 Then
        dd = MsgBox("Aucune ligne vide trouvée ...", 64, "Résultat")
    ElseIf Nb = 0 Then
        dd = MsgBox("Aucun doublon trouvé dans la colonnne " & UCase(choix2) & " ...", 64, "Résultat")
    ElseIf choix = 5 Then
        dd = MsgBox(Nb & " lignes supprimées (en " & res_test & " secondes)", 64, "Résultat")
    ElseIf choix = 4 Then
        dd = MsgBox(Nb & " doublons supprimés (en " & res_test & " secondes)", 64, "Résultat")
    ElseIf choix = 3 Then
        dd = MsgBox(Nb & " doublons effacés (en " & res_test & " secondes)", 64, "Résultat")
    Else
        dd = MsgBox(Nb & " doublons passés en rouge (en " & res_test & " secondes)", 64, "Résultat")
    End If

End Sub

Cependant, le choix n°3 ne me satisfait que partiellement car je souhaiterais qu'il ne m'efface pas les lignes entières, mais uniquement des plages de cellules de ces ligne:

De la colonne "B" à la colonne "I".

Est-ce possible?

Merci d'avance pour vos solutions.

Bonjour,

Sébastien m'a apporté la solution que j'attendais.

Par conséquent je vous la transmet:

Essaie de remplacer :

                    If choix = 3 Then
                        Range(ligne & ":" & ligne).ClearContents
                    Else

Par :

                    If choix = 3 Then
                        Range("B" & ligne & ":I" & ligne).ClearContents
                    Else

En espérant que cela serve à d'autres!

Bonne soirée.