Поиск так, чтобы везде

[Svap]

Здравствуйте.
Подскажите, пожалуйста, текст макроса, осуществляющий:
1 поиск во всех столбцах по всем листам книги
2 искомый текст - код запчасти, вводится через форму
3 результат (все строки, содержащие искомый текст) выводится на новый лист этой книги

При этом:
- Количество листов непостоянно;
- В искомый код запчасти необходимо вставлять знак "-" после пятого символа и вести поиск двух строк - введенной в форму и преобразованной вставкой тире;
- В результирующем листе все строки с найденными исходными текстами начинались бы с ячейки, содержащей имя листа, где эта строка нашлась. Можно имя листа заменить на гиперссылку на искомую строку в "родительском" листе (что было бы намного лучше)

Заранее Всем ОГРОМНОЕ СПАСИБО!!!

[IgorGO]

я как прочитал тему заинтересовался - не надо ли случайно для поиска выходить за пределы вселенной (ну, так..., чтобы везде).
Как поискать на листе знаете? (не знаете сделайте это вручную и запишите рекордером свои действия). То что рекордер запишет для конкретного листа вставьте в цикл по листам, поправьте чуть-чуть - вот задача и решена
Успехов!

[Svap]

Пока ума хватило только вот на это:

Sub Макрос3()
Search = InputBox("Введите код детали", "Поиск запчасти")
If Search = "" Then Exit Sub
Cells.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.EntireRow.Copy
Sheets.Add
ActiveSheet.Paste
End Sub

Но:
1 ищется только первое вхождение искомой строки и как зациклить на все листы книги?
2 как сделать так, чтобы поиск искал два кода детали - введенный в форму код, например "1234567890", и этот же код но с тире после 5-го символа, например "12345-67890"?

[doober]

Предлагаю карту Млечного пути для ориентировки ,и код.

А далее Вы решите как применять

[EducatedFool]

Вот вам макрос для всех листов:

Sub test()
    Application.ScreenUpdating = False
    SearchStr = InputBox("Введите код детали", "Поиск запчасти")
    If SearchStr = "" Then Exit Sub
    On Error Resume Next

    Dim NEWsh As Worksheet: Set NEWsh = Worksheets.Add    ' создаём итоговый лист
    NEWsh.Name = "результат": NEWsh.Tab.Color = vbGreen
    Dim sh As Worksheet, firstAddress As String, c As Range, strAddress As String
    Dim cell As Range, ra As Range
    For Each sh In ThisWorkbook.Worksheets    ' перебираем все листы
        If sh.Name <> NEWsh.Name Then
            firstAddress = "": strAddress = ""
            With sh.UsedRange
                Set c = .Find(SearchStr, LookIn:=xlValues)
                If Not c Is Nothing Then
                    firstAddress = c.Address
                    strAddress = firstAddress
                    Do
                        Set c = .FindNext(c)
                        strAddress = strAddress & "," & c.Address
                    Loop While Not c Is Nothing And c.Address <> firstAddress
                End If

                'Debug.Print sh.Name, strAddress
                For Each cell In sh.Range(strAddress).EntireRow
                    Set ra = NEWsh.Range("a" & NEWsh.Rows.Count).End(xlUp).Offset(1)
                    Intersect(cell, cell.Worksheet.Range("a:z")).Copy ra.Next
                    ra = cell.Worksheet.Name
                Next cell
            End With
        End If
    Next
End Sub

Немного переделав его, получите то, что вам нужно.

[Svap]

Н-да... Оказывается не перевелись добрые волшебники в наше время.

Благодарности EducatedFool'у за все и doober'у за метод внедрения тире в строку поиска

PS. Как много людей, которым не дает покоя нереализованные детские грезы о далеком космосе