переход с листа на лист по одинаковому значению

[Uralmaster]

вопрос еще остался элементарный
Название предприятия-клиента фигурирует в двух листах
Как сделать так чтобы по щелчку мыши на ячейку (где забито название предприятия)на 1 листе я переместился на 2 лист в ячейку с названием этого же предприятия. Название предприятия на обоих листах один в один - совпадает.

[doober]

Код в модуле Листа1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim X As Range
If Target.Text <> "" Then
Set X = Sheets(2).UsedRange.Find(Target.Text)
If Not X Is Nothing Then
Sheets(2).Activate
X.Activate
End If: End If
End Sub

[vfv]

Если после перехода на лист2 окажется две или три ячейки с таким же точно названием предприятия,как и на лист1,как сделать,чтобы они все одновременно стали выделены?

[kuklp]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim X As Range, r As Range, fA$
    If Target.Text <> "" Then
        Set X = Sheets(2).UsedRange.Find(Target.Text)
        If Not X Is Nothing Then
            Set r = X
            fA = X.Address
            Do
                Set X = Sheets(2).UsedRange.FindNext(X)
                Set r = Application.Union(r, X)
            Loop While Not X Is Nothing And X.Address <> fA
        End If
        Sheets(2).Activate
        r.Select
    End If
    Cancel = True
End Sub

[vfv]

Спасибо!Всё работает.
А если не окажется слова из листа1,как сделать,чтобы не открывался автоматом редактор VBA с подсвеченным r.Select

[IgorGO]

обработать ошибку.
on error resume next
r.Select
on error goto 0

[kuklp]

Привет, Игорь. Не так. Если такого нет на 2 листе - нафиг туда переходить, переходим в режим редактирования.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim X As Range, r As Range, fA$
    If Target.Text <> "" Then
        Set X = Sheets(2).UsedRange.Find(Target.Text)
        If Not X Is Nothing Then
            Set r = X
            fA = X.Address
            Do
                Set X = Sheets(2).UsedRange.FindNext(X)
                Set r = Application.Union(r, X)
            Loop While Not X Is Nothing And X.Address <> fA
            Sheets(2).Activate
            r.Select
         Cancel = True
        End If: End If
End Sub

И окончательный вариант в файле. Для чего это надо, проверяем на листе 3.

[Uralmaster]

Большое спасибо за поддержку еще один вопрос как сделать так чтобы используя данную формулу сделать ячейку на листе 1 ( назовем ее поиск) куда вводим искомый текст; далее по кнопке макроса выделяем ячейку с таким же текстом на
том же листе 1 заготовка в файле приложенном ( стандартная функция поиск значения - текста неудобна - либо кнопку функции выводишь в панель либо в меню надо лазить каждый раз )

[kuklp]

У Вас что, макрорекордер не работает? Уже такую ерунду можно было бы и самому сделать.

[Uralmaster]

Начальные познания еще
Макрос работает спасибо - единственное только работает когда снимешь выделение с ячейки С4 "поиск" как сделать чтобы искал без снятия выделения ячейки с поисковым словом - те написал слово и сразу кнопку нажал...