Problème avec les doublons

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, lig%, plage$
If [E5] = "" Then [H5, D9:D13, C8, C13] = "": [E5].Activate: _
ActiveSheet.Shapes("pointeur").Visible = False: ActiveSheet.Shapes("attention").Visible = False: Exit Sub
    
      If [E5] <> "" Then
        lig = Sheets(2).UsedRange.Rows.Count
        If lig < 2 Then: Exit Sub: [E5].Select
        
        i = 0
        With Sheets(2).Range("A2:G" & lig)
            Set cel = .Find("*" & Range("E5").Value & "*", LookIn:=xlValues, LookAt:=xlWhole)
            If Not cel Is Nothing Then
                firstAddress = cel.Address
                Do
                ReDim Preserve Tablo(6, i)
                    Tablo(0, i) = Sheets(2).Range("A" & cel.Row).Value
                    Tablo(1, i) = Sheets(2).Range("B" & cel.Row).Value
                    Tablo(2, i) = Sheets(2).Range("C" & cel.Row).Value
                    Tablo(3, i) = Sheets(2).Range("D" & cel.Row).Value
                    Tablo(4, i) = Sheets(2).Range("E" & cel.Row).Value
                    Tablo(5, i) = Sheets(2).Range("F" & cel.Row).Value
                    Tablo(6, i) = Sheets(2).Range("G" & cel.Row).Value
                    ActiveSheet.Shapes("pointeur").Visible = True
                    i = i + 1
                Set cel = .FindNext(cel)
                Loop While Not cel Is Nothing And cel.Address <> firstAddress
                UserForm1.Show
                Else
        [C8].Value = "Désolé, aucun résultat trouvé."
         ActiveSheet.Shapes("attention").Visible = True
        Exit Sub
            End If
        End With
        End If

End Sub
'--------------------------------------------------------------------------
Private Sub UserForm_Initialize()

With ListBox1
    .Clear
    .ColumnCount = 6
    .ColumnWidths = "50;50;100;20;50;50"
    .Column = Tablo
End With

End Sub
'--------------------------------------------------------------------------
Private Sub ListBox1_Click()
If ListBox1.ListIndex <> -1 Then
    Worksheets("Recherche").[D9].Value = ListBox1.List(ListBox1.ListIndex, 0) & " " & ListBox1.List(ListBox1.ListIndex, 1)
    Worksheets("Recherche").[D10].Value = ListBox1.List(ListBox1.ListIndex, 2)
    Worksheets("Recherche").[D11].Value = ListBox1.List(ListBox1.ListIndex, 3) & " " & ListBox1.List(ListBox1.ListIndex, 4)
    Worksheets("Recherche").[D13].Value = ListBox1.List(ListBox1.ListIndex, 5)
    Worksheets("Recherche").[C13].Value = ListBox1.List(ListBox1.ListIndex, 6)
End If
Unload Me
Erase Tablo
Call map
End Sub