Option Explicit
Option Compare Text
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
        Dim j As Long, i As Long, poisk As Range, iAdr$, LT%, sh As Worksheet
        ListBox1.Clear
        LT = Len(TextBox1.Value)
        If LT = 0 Then Exit Sub
        j = 0
        iAdr = ActiveSheet.UsedRange.Address
        iAdr = Mid(iAdr, InStr(iAdr, ":") + 1)
        For Each sh In ActiveWorkbook.Sheets
            For Each poisk In sh.UsedRange
            On Error Resume Next
            If poisk Like "*" & TextBox1.Value & "*" Then
                ListBox1.AddItem sh.Name & "!" & poisk.Address
                ListBox1.List(j, 1) = poisk
                j = j + 1
            End If
            Next
        Next
End Sub
Private Sub ListBox1_Click()
Dim sh As Worksheet, r As Range, m
        If ListBox1.ListIndex = -1 Then Exit Sub
        m = Split(ListBox1, "!")
        Set sh = Sheets(m(0)): Set r = sh.Range(m(1))
        sh.Activate: r.Select
End Sub