Поиск по всем листам другой книги

[sboy]

Возможно надо понять, что должно получиться в итоге)

[10Dmitriy10]

Тоже самое) Сейчас поиск идет до первого совпадения.

Нужно чтобы выдал второе, (3е, 4е)  после повторного нажатия на кнопку (повтор цикла).

[sboy]

Код (vb) Выделить Развернуть

Sub Poisk_CNum()

Dim x As Variant
Dim WB As Workbook
Dim i As Integer
Dim rFind As Range
    x = Cells(2, 2).Value
    Set WB = Application.Workbooks("1.xlsx")
    For i = 1 To WB.Sheets.Count
        With WB.Sheets(i).Cells
        Set rFind = .Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
            If Not rFind Is Nothing Then
                Sheets(1).Range("B7").Value = rFind.Offset(0, -3).Value
                Sheets(1).Range("C7").Value = rFind.Offset(0, -2).Value
                firstAddress = rFind.Address
                    Do
                        MsgBox "Нашел на листе " & WB.Sheets(i).Name & rFind.Address
                        Set rFind = .FindNext(rFind)
                    Loop While Not rFind Is Nothing And rFind.Address <> firstAddress
            End If
        End With
    Next i
End Sub

[10Dmitriy10]

Почти в яблочко)
только:
1) Выводить имя листа в Ячейку А7  

Код (vb) Выделить Развернуть

Cells (7,2) = WB.Sheets(i).Name
Но в таком виде как-то дальше не идет поиск
2) Цикл сейчас "не отпускает", т.е пролистываю значения нажатием кноаки "Ок" в  MsgBox, но остановиться на нужном не могу.

Нужно найти, выдать информацию и выйти из цикла. Следующий клик - найти второе и т.д)

[10Dmitriy10]

Cells (7,1) = WB.Sheets(i).Name   

[sboy]

Почти в яблочко)

я с Вами в бабу Вангу играть не собираюсь...
перечитайте посты №12 и №15

[10Dmitriy10]

Исправлюсь)
Вот в таком виде работает почти как надо.

Код (vb) Выделить Развернуть


Sub Poisk_CNum()
Dim x As Variant
Dim WB As Workbook
Dim i As Integer
Dim rFind As Range
x = Cells(2, 2).Value
Set WB = Application.Workbooks("1.xlsx")
For i = 1 To WB.Sheets.Count
With WB.Sheets(i).Cells
Set rFind = .Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not rFind Is Nothing Then
firstAddress = rFind.Address
Do
MsgBox "Naschel na  " & WB.Sheets(i).Name
'& rFind.Address
Set rFind = .FindNext(rFind)
Sheets(1).Range("B7").Value = rFind.Offset(0, -3).Value
Sheets(1).Range("C7").Value = rFind.Offset(0, -2).Value
Sheets(1).Range("A7").Value = WB.Sheets(i).Name
Loop While Not rFind Is Nothing And rFind.Address <> firstAddress
End If
End With
Next i
End Sub

Только не работает без MsgBox..    Да и с ним я не могу остановиться на нужном найденном значении.. могу только просмотреть все.

[10Dmitriy10]

Рабочий код. Если кому надо.

Код (vb) Выделить Развернуть


Sub Poisk_CNum()
    Dim x As Variant
    Dim f As Boolean
        Dim WB As Workbook
    Dim i As Integer
    Dim rFind As Range
    x = Cells(2, 2).Value
    Set WB = Application.Workbooks("1.xlsx")
        For i = 1 To WB.Sheets.Count
            With WB.Sheets(i).Cells
                Set rFind = .Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
                If Not rFind Is Nothing Then
                    firstAddress = rFind.Address
                    Do
                    'MsgBox "Naschel na  " & WB.Sheets(i).Name
                    '& rFind.Address
                        If MsgBox("Naschel na  " & WB.Sheets(i).Name, vbYesNo, "Confirm") = vbYes Then
                            Set rFind = .FindNext(rFind)
                            Sheets(1).Range("A7").Value = WB.Sheets(i).Name
                            Sheets(1).Range("B7").Value = rFind.Offset(0, -3).Value
                            Sheets(1).Range("C7").Value = rFind.Offset(0, -2).Value
                        End If
                        If MsgBox("Naschel na  " & WB.Sheets(i).Name, vbYesNo, "Confirm") = vbNo Then
                            f = True
                        End If
                            If f Then
                                 Exit For
                            End If
                Loop While Not rFind Is Nothing And rFind.Address <> firstAddress
                End If
            End With
        Next i
End Sub