Sub ПоискЗначений()
Dim Rng As Range, Адрес As String
ListBox1.Clear

With Worksheets("Лист2") 'добавлено
  With .Range("A7:A" & .Cells(Rows.Count, 1).End(xlUp).Row) 'изменено
    Set Rng = .Find(Me.TextBox1.Value, , , Abs(Abs(chbxPart + 1) + 1))
    If Not Rng Is Nothing Then
        Адрес = Rng.Address
        Do
            ListBox1.AddItem Rng: Set Rng = .FindNext(Rng)
        Loop While Адрес <> Rng.Address
    End If
  End With 'добавлено
End With

End Sub