Champ de Recherche via VB avec liens

Option Compare Text
Dim nom As String
Dim DerniereLigneUtilisee As Long
Private Sub ListBox1_Click()
 Dim i As Byte
     'boucle sur les éléments de la listbox
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then nom = ListBox1.List(i)
    Next i
     SearchAllSheets 'recherche dans toutes les feuilles
End Sub
Private Sub TextBox1_Change()
     Application.ScreenUpdating = False
     Range("A2:A24").Interior.ColorIndex = 2
    ListBox1.Clear
    If TextBox1 <> "" Then
        For ligne = 2 To 24
            If Cells(ligne, 1) Like "*" & TextBox1 & "*" Then
                Cells(ligne, 1).Interior.ColorIndex = 43
                ListBox1.AddItem Cells(ligne, 1)
            End If
        Next
    End If
End Sub
Sub SearchAllSheets() 'recherche dans toutes les feuilles
'JE McGimpsey, mpep
Dim strSearchString As String
Dim ws As Worksheet
Dim foundCell As Range
Dim returnValue As Variant
Dim loopAddr As String
Dim countTot As Long
Dim counter As Long
strSearchString = nom
  For Each ws In Worksheets
    countTot = countTot + Application.CountIf( _
                ws.UsedRange, "=" & strSearchString)
  Next ws
  If countTot = 0 Then
    MsgBox strSearchString & " not found."
  Else
   counter = 0
    For Each ws In Worksheets
      With ws
        .Activate
        Set foundCell = .Cells.Find( _
            What:=strSearchString, _
            LookIn:=xlValues, _
            LookAt:=xlPart)
        If Not foundCell Is Nothing Then
          loopAddr = foundCell.Address
          Do
            counter = counter + 1
            foundCell.Activate
            returnValue = MsgBox(ws.Name & "  Found '" & strSearchString & _
                  "' at " & foundCell.Address & vbNewLine & _
                  "(" & counter & " of " & countTot & ")", _
                  vbOKCancel)
                   DerniereLigneUtilisee = Range("H" & Rows.Count).End(xlUp).Row + 1
             Range("H" & DerniereLigneUtilisee).Value = ws.Name 'nom de la feuille
             Range("I" & DerniereLigneUtilisee).Value = foundCell.Address 'adresse
            If returnValue = vbCancel Then Exit For
            Set foundCell = .Cells.FindNext( _
                  After:=foundCell)
          Loop While Not foundCell Is Nothing And _
                  foundCell.Address <> loopAddr
        End If
      End With
    Next ws
  End If
End Sub 'SearchAllShee