Макрос в excel для поиска по всем листам

в данный момент у меня код модуля вот такой  

  Option Explicit  

  Sub Поиск()  
Dim iFoundRng As Range  
Dim iSheet As Worksheet  
Dim iFoundSht As Worksheet  
Dim FirstAddress As String  
Dim TextToFind As Variant  
Dim iLastRow As Long  
Dim iShtName As String  

         Set iFoundSht = Sheets(«Поиск») ‘лист «Поиск» присваиваем переменной  
   iFoundSht.Range(«A5:AA5000»).Clear ‘очищаем диапазон ячеек на листе Поиск  
   ‘TextToFind = Application.InputBox(«Введите строку для поиска» & Chr(13) & Chr(13) & «Например: Lexus или Lexus 350», «Поиск», «Lexus 350»)  
   TextToFind = iFoundSht.Range(«B2»)  
   If TextToFind = «» Or TextToFind = False Then Exit Sub ‘если ничего не ввели — Выход!  
   TextToFind = Trim(TextToFind) ‘убираем начальные и конечные пробелы  
   Application.ScreenUpdating = False ‘отключаем обновление экрана  
   For Each iSheet In ThisWorkbook.Worksheets ‘поиск по листам  
       If iSheet.Name <> iFoundSht.Name Then  
           If iSheet.FilterMode = True Then iSheet.ShowAllData ‘если на листе установлен автофильтр, то снимаем его  
           Set iFoundRng = iSheet.Cells.Find(TextToFind, , xlFormulas, xlPart)  
           If Not iFoundRng Is Nothing Then ‘если нашли  
               FirstAddress = iFoundRng.Address ‘запоминаем адрес найденной ячейки, чтобы продолжить поиск по листу  
               Do  
                   With iFoundSht  
                       iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row ‘определяем последнюю заполненную строку на листе поиск  
                       If iLastRow = 1 Then iLastRow = 4 ‘если лист пуст, то вставлять будем начиная с 7-й строки  
                       If iShtName <> iSheet.Name Then ‘если новый прайс-лист  
                           With .Cells(iLastRow + 1, 1) ‘проставляем имя листа  
                               .Value = «Лист: » & iSheet.Name & » Ячейка: » & iFoundRng.Address(0, 0)  
                               ‘добавляем гиперссылку  
                               iFoundSht.Hyperlinks.Add Anchor:=iFoundSht.Cells(iLastRow + 1, 1), Address:=»», _  
                                   SubAddress:=»‘» & iSheet.Name & «‘» & «!» & iFoundRng.Address, ScreenTip:=»Перейти на лист » & iSheet.Name  
                               ‘.Font.Bold = True ‘выделяем жирным  
                           End With  
                       End If  
                       ‘iFoundRng.EntireRow.Copy Destination:=.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) ‘копируем всю строку  
                       iShtName = iSheet.Name ‘запоминаем имя листа  
                   End With  
                   Set iFoundRng = iSheet.Cells.FindNext(iFoundRng) ‘продолжаем поиск на том же листе  
               Loop While iFoundRng.Address <> FirstAddress  
           End If  
       End If  
   Next iSheet  
   Application.ScreenUpdating = True ‘включаем обновление экрана  
   MsgBox «Поиск завершён!», 64, «Поиск»  
End Sub  

  Sub Finder()  
Dim iRng As Range, TextForFind As String, FirstAddress As String, n As Integer, iLastRow As Long  
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
Range(Cells(5, 1), Cells(iLastRow + 1, 2)).Clear  
iLastRow = 4  
   TextForFind = InputBox(«Введите искомое слово (значение)», » Запрос для поиска»)  
   If TextForFind = «» Then  
       MsgBox «Вы ничего не указали», 48, «Вы чё, в натуре?»  
       Exit Sub  
   End If  

     For n = 2 To Sheets.Count  
       With Sheets(n).UsedRange  
           Set iRng = .Find(What:=TextForFind, LookIn:=xlFormulas, LookAt:=xlPart)  
           If Not iRng Is Nothing Then  
               FirstAddress = iRng.Address  
               Do  
                   Cells(iLastRow + 1, 1) = Sheets(n).Name  
                   Cells(iLastRow + 1, 2) = iRng.Address(0, 0)  
                   iLastRow = iLastRow + 1  
                   Set iRng = .FindNext(iRng)  
               Loop While iRng.Address <> FirstAddress  
           Else  
               MsgBox «Значение » & TextForFind & » не найдено!», 48, «Ошибка»  
           End If  
       End With  
   Next  
End Sub  

  по вашим словам я могу оставить только последнюю часть данного кода?

Добрый день, Narimanych, Burk, извиняюсь что не ответил сразу, экстренно улетал в командировку на дальние рубежи Родины (без досутпа в сеть). Спасибо за Ваши отклики!

Файл с примером прилагаю, заодно уже вставил в него макрос от Burk, макрос замечательно работает, но вывод адреса происходит не в ячейку. Впринципе, если число искомых значений невелико, эти адреса можно записать вручную, но все же хотелось бы что бы они выводились в отдельный задаваемый столбец.

Указание адреса листа и номера ячейки в столбце нужно для того, что бы можно было использовать этот адрес для формулы перемножения значений в других ячейках этой строки.

Т.е. макрос выдает адрес ячейки ‘2 Apr 2019’!A13, другая формула должна считать по такому алгоритму:

=’2 Apr 2019′!A13/СРЗНАЧ(‘1 Apr 2019:7 Apr 2019’!A1:A200)

т.е. нужно найти отношение найденного уникального значения к среднему арифметическому задаваемого диапазона на задаваемом листе. Смысл в том, что бы можно было получать адрес, и потом получая через ДВССЫЛ числовое значение этой ячейки сравнивать его с другими средними, максимальными, минимальными значениями диапазаона.

и использовать номер листа что бы искать другие значения в других столбцах той же строки, например = ‘2 Apr 2019’!B13

Cпасибо!

This is the ultimate Lookup Macro for Excel. It will search every worksheet in the workbook and return all of the matching results to a single worksheet. You do not have to specify a specific lookup_table and the data can be located anywhere on the worksheets and it will still be found and returned with this macro.

Sub Return_Results_Entire_Workbook()

'This does not search the worksheet that will contain the results of the search

' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' ||||||||||||||||||| ------------ TeachExcel.com -------------- |||||||||||||||||||||||||
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

'Number for the worksheet that contains the value for which to search
searchValueSheet = "Sheet1"

'Get the value for which we need to search into the macro
searchValue = Sheets(searchValueSheet).Range("A2").Value

'how many columns to the right of any "found" value that you want to use to return the data
returnValueOffset = 1

'The sheet where the results should be placed
outputValueSheet = "Sheet1"

'The column in the sheet where the results should be placed
outputValueCol = 2

'The row in the sheet where the results should be placed
'everything from this row down must be empty!
outputValueRow = 2

'clear the results display area
Sheets(outputValueSheet).Range(Cells(outputValueRow, outputValueCol), Cells(Rows.Count, outputValueCol)).Clear


'count the worksheets in the workbook
wsCount = ActiveWorkbook.Worksheets.Count

'loop through the worksheets in the workbook
For i = 1 To wsCount
    
    'Don't search the sheet with the lookup value or returned values - assumes source data will be on other tabs.
    If i <> Sheets(searchValueSheet).Index And i <> Sheets(outputValueSheet).Index Then
    
        'Perform the search, which is a two-step process below
        Set Rng = Worksheets(i).Cells.Find(What:=searchValue, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
                
        If Not Rng Is Nothing Then
        
            rangeLoopAddress = Rng.Address
            
            Do
                Set Rng = Sheets(i).Cells.FindNext(Rng)
                Sheets(outputValueSheet).Cells(Cells(Rows.Count, outputValueCol).End(xlUp).Row + 1, outputValueCol).Value = Sheets(i).Range(Rng.Address).Offset(0, returnValueOffset).Value
            Loop While Not Rng Is Nothing And Rng.Address <> rangeLoopAddress
            
        End If
    
    End If

Next i


End Sub 

The code above may seem confusing but you really only have to change a few things to get it to work with your data.

You will have to tell the macro which worksheet contains the value you are searching for, where that search value is located, on which worksheet you want to return the data once it is found and where within that worksheet you want to display the data.

First, change the searchValueSheet to the name of the worksheet that contains the value for which you want to search, the searchValue.

The searchValue is the cell reference of the cell that is used to locate the data to return. Change A2 to the reference of the cell that contains the value you are searching for or the cell where you will input that value. Remember, this cell should be located on the searchValueSheet mentioned above.

The returnValueOffset is a very important value. This tells the macro how far to the right to go to find the data that you want to return once a match for the searchValue has been found. Note that the returned data must come from the same row as the data that matches the searchValue.

The outputValueSheet is the name of the worksheet where you want to return the data. Change the name from Sheet1 to whatever you need. This can be the same as the searchValueSheet or different, it doesn’t matter.

The outputValueCol is the column where you want to display the results within the outputValueSheet

The outputValueRow is the first row in which the returned results should be displayed in the outputValueCol on the outputValueSheet.

Anothing important thing to note is that this macro will NOT search through the worksheets that are referenced by the searchValueSheet or the outputValueSheet. This should not usually matter but, if it does, the easiest solution is to create a specific «Search» tab and set the macro to return everything there.

It may seem like a lot to change, but at least I made it easy for you! And, once you set this macro up to work the way you want, it will save you TONS of time.

I hope this helps!