процедура с параметром вызывает функцию

[subluna]

и код перерисовала вот так:

Sub FindererALL2()
Dim FD, firstAddress, adrs, actList, OriginalRange As String
actList = ActiveSheet.Name 'на активном листе
ActiveSheet.Shapes(Application.Caller).Select 'клик по синей кнопке, получили значение надписи
FD = Selection.Characters.Text ' и присвоили переменной FD
If FD = "" Then Exit Sub ' если кнпк ОТМЕНА - отказ от поиска
Sheets("Ãëàâíûé îôèñ").Select 'перешли на лист с базой
Dim c As Range: Set c = Range("C:C").Find(FD) ' поиск №каб если ничего нету - выход из макроса
If c Is Nothing Then MsgBox "Оборудование по " & FD & " не найдено", vbExclamation: Exit Sub 'с сообщением НЕТУ НИЧЕГО
firstAddress = c.Address 'иначе - поехали перебирать
c.Select
OriginalStr = ""
Do
    adrs = adrs & vbLf & c.Address(0, 0)
    n = c.Row
      OriginalRange = OriginalRange & vbLf & Range("B" & n) & " " & Range("D" & n) & " " & Range("e" & n) & " " & Range("f" & n) & " " & Range("h" & n) & " " & Range("g" & n) & " " & Range("q" & n) & " " & Range("r" & n) ' и напихивать в офигеть какую длиную строку значения ячеек
    Union(Selection, c).Select
    Set c = Range("c:c").FindNext(c)
Loop While c.Address <> firstAddress ' и так пока условие выполняется
Sheets(actList).Select ' перешли на лист с кнопками
MsgBox "Значение """ & FD & """ найдено в ячейке:" & adrs, vbOKOnly
MsgBox "Значению """ & FD & """ соответствуют:" & OriginalRange, vbInformation
End Sub

но КАК КАК ЖЕ мне построить из найденных строк таблицу в ListBox?
з.ы. хочу добавить, что если бы не ваш форум, я б ето не нарисовала! СПАСИБО!
з.з.ы. А Игорю - отдельное спасибо, что пароль на макросы так и не прислал, за то я по научилась немного )

[Hugo121]

Такой полуфабрикат:

Option Explicit

Sub tt()
    Dim x As Range: Application.ScreenUpdating = False
    Dim a(), FD
    FD = InputBox("ВВЕДИТЕ ИСКОМОЕ СЛОВО ИЛИ ЧИСЛО", "Поиск оборудования")
    If FD = "" Then Exit Sub    ' если кнопк ОТМЕНА - отказ от поиска
    Rows.Hidden = False
    Set x = [C:C].Find(FD, , , xlWhole)
    If Not x Is Nothing Then
        [C:C].ColumnDifferences(x).EntireRow.Hidden = True
        a = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Value
        Rows.Hidden = False
    End If
    Application.ScreenUpdating = True
End Sub

Теперь массив а можно выгрузить куда угодно, например в листбокс.
Для этого его можно объявить публично, а не в этом макросе, и потом использовать в форме.

[Hugo121]

Т.е. так:

Option Explicit

Public a()

Sub tt()
    Dim x As Range: Application.ScreenUpdating = False
    Dim FD
    FD = InputBox("ВВЕДИТЕ ИСКОМОЕ СЛОВО ИЛИ ЧИСЛО", "Поиск оборудования")
    If FD = "" Then Exit Sub    ' если кнопк ОТМЕНА - отказ от поиска
    Rows.Hidden = False
    Set x = [C:C].Find(FD, , , xlWhole)
    If Not x Is Nothing Then
        [C:C].ColumnDifferences(x).EntireRow.Hidden = True
        a = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Value
        Rows.Hidden = False
    End If
    UserForm1.Show
    Application.ScreenUpdating = True
End Sub

И в форме:

Private Sub CommandButton1_Click()
Me.Hide
tt
End Sub

Private Sub UserForm_Activate()
    ListBox1.List = a
    ListBox1.ColumnCount = UBound(a, 2)
End Sub

Предварительно на существующую форму добавьте листбокс ListBox1.

[Hugo121]

На случай, если ничего не найдётся, можно поступить так:
перед формированием массива из найденного, можно сделать массив с одной записью:

    ReDim a(1 To 1, 1 To 1)
    a(1, 1) = "Нет данных!!!"

Тогда форма покажет этот массив, если не будет другого.

[subluna]

Спасибо, Hugo121!!
сейчас попробую))
Здоровско так у вас тут, никто не тыкает носом в непрофессионализм, все помогают. Я так рада была сегодня, когда код заработал и даже немного с ListBox'ом поэкспериментила ))

[Hugo121]

Приятно видеть, когда человек старается что-то сделать сам, и видно, что помогаешь с толком.
Не то, что некоторые бездельники - сделайте мне, я сам никогда это использовать не буду... А потом сидят в офисах, на калькуляторе считают... как и обещали

[subluna]

вот так теперь выглядит процедура:

Option Explicit ' разрешаем неявное объявление переменных чтоб потом не догадываться чего в процедуру не передали
Public a() ' объявляем публичную переменную в которую  запись будем писать для запуска в любом модуле
Public actList As String ' объявляем публичную переменную в которую  запись будеми писать для запуска в любом модуле

Sub ttab() ' процедура ttab
    Dim x As Range, FD ' объявили переменные
    Application.ScreenUpdating = False 'запретили автообновление окна приложения_
                                       'чтобы окна не моргали
   actList = ActiveSheet.Name 'запомнили активный лист
  ActiveSheet.Shapes(Application.Caller).Select 'клик по синей кнопке, получили значение надписи
   FD = Selection.Characters.Text ' и присвоили переменной FD
If FD = "" Then Exit Sub ' если кнпк ОТМЕНА - отказ от поиска
    Sheets("Главный офис").Select 'перешли на лист с базой
    Set x = [C:C].Find(FD, , , xlWhole) ' назначаем перем х область яч столбец С _
                                        ' и ищем вхождение FD полное совпадение (xlWhole)
    If Not x Is Nothing Then 'если в х написалось чегот найденное то
       [C:C].ColumnDifferences(x).EntireRow.Hidden = True 'скрываем все строки не попавшие в сравнение
        Rows("1:1").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = True 'скрываем все ненужные столбцы
       a = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Value 'и передаем в публичную переменную фсе что осталось
       UserForm2.ListBox1.ColumnHeads = True
       UserForm2.ListBox1.List = a
       UserForm2.Label2.Caption = FD
        Rows.Hidden = False ' а теперь покажем фсе строки опять
        Columns.Hidden = False ' а теперь покажем фсе столбцы опять

    End If 'ну и завершим проверку
    UserForm2.Show 'покажем форму с ListBox'ом
    Sheets(actList).Select ' перешли на лист с кнопками
    Application.ScreenUpdating = True 'а теперь пусть окна ёкселя моргают при вызовах методов
End Sub

и код формы:

Private Sub CommandButton1_Click()
Me.Hide
End Sub

Private Sub ListBox1_Click()
ColumnHeads = True
ColumnCount = 8
ColumnWidths = "20;15;4;12;7;2;8;16"
End Sub

но в ListBox заголовки столбцов передать не могу. они в row5 на листе с базой, а в переменную a передается только видимая область. можно как то эту область расширить, чтобы туда всегда первой попадала row5?

[Hugo121]

Если заголовки столбцов постоянны (как это обычно бывает), то их можно заранее написать на форме в виде Labels. А можно и динамически.
Можно создать другой массив чуть повыше, заполнить его первую строку заголовками (взять отдельным ходом с листа или просто забить известные надписи), далее переложить данные из массива a.
Можно после 'скрываем все ненужные столбцы - СТРОКИ!!! открыть первую строку с заголовками, и уж потом брать видимые в массив
Можно ещё что-нибудь придумать...

[subluna]

Rows("5:5").Hidden = False
       Rows("1:1").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = True 'скрываем все ненужные столбцы
       a = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Value 'и передаем в публичную переменную фсе что осталось

и на листе с базой картинка правильная а в ListBox передается тольк row5
Hygo121, голубчик, где я туплю?
у меня опять ночь уже(

[Hugo121]

Нда, в массив так данные не берутся - только первая строка, т.е. первый слитный диапазон... Не знал.
У кого какие предложения? Как сделать дальше оптимально?