Поиск и вывод результата на другой лист!!!

[Ilnour1986]

ВСЕМ привет!!!
У меня есть таблица, есть кнопка поиска, листинг вот:

Dim s() As Variant
Private Sub sort(t As Variant)
Dim i As Integer
flag = 1
While flag = 1
flag = 0
For i = 1 To UBound(t) - 1
If t(i) > t(i + 1) Then
tmp = t(i)
t(i) = t(i + 1)
t(i + 1) = tmp
flag = 1
End If
Next
Wend
End Sub

Function poisk(a)
Dim r()
If a = "" Then
ReDim Preserve r(0)
r(0) = -1
poisk = r
Exit Function 'ничего не ввели или нажали Cancel
End If
Set c = Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If c Is Nothing Then
ReDim Preserve r(0)
poisk = r
Exit Function
End If
ReDim Preserve r(0)
r(0) = c.Row

Set st = c 'запоминаем первую найденную ячейку
Do 'цикл
Set c = Cells.FindNext(After:=c) 'следующая найденная ячейка
i = i + 1
ReDim Preserve r(i)
r(i) = c.Row
Loop Until c.Address = st.Address
poisk = r
End Function

Private Sub CommandButton1_Click()
Cells(1, 1).Activate
a = InputBox("ВВЕДИТЕ СТАТЬЮ", "ПОИСК СТАТЕЙ", "Какая статья вас интересует???")
s = poisk(a)

Select Case s(UBound(s))
Case -1
Exit Sub
Case ""
MsgBox ("Данные не найдены")
Exit Sub
End Select
Call sort(s)
For i = 1 To UBound(s)
NextRow = _
Application.WorksheetFunction.Count A(Range("A:A")) + 1
Cells(NextRow, 1) = Cells(s(i), 1).Text
Cells(NextRow, 2) = Cells(s(i), 2).Text
Cells(NextRow, 3) = Cells(s(i), 3).Text
Cells(NextRow, 4) = Cells(s(i), 4).Text
Next
End Sub

http://www.programmersforum.ru/attac...1&d=1255713409

Но результат выводит вниз таблицы!
А мне очень нужно, чтобы создавался Лист новый, например, "Результат" и чтобы туда выводился поиск, причём тут в таблице у меня 4 столбца, а на самом деле размерность может увеличиваться, быть и 10 столбцов и 3 и надо чтобы поиск ХОРОШО работал!!!
Кто знает, знающие люди, помогите, пожалуйсто

[EugeneS]

без файла и четкого описания что ищем и что получаем в результате ничего не выйдет

[Ilnour1986]

Я написал чётко, что мне нужно и где выводить!!!
ОЧЕНЬ прошу помощи, мне это очень нужно!!!
Помогите, пожалуйсто!

[SAS888]

Как правильно заметил EugeneS, без примера файла ответ может быть не точный. Если я правильно понял задачу, то требуется на новый лист (в примере это лист "NewSheet") вывести из листа с кнопкой (активного), те строки, в которых значения ячейки в столбце "A" соответствуют значению, введенному для поиска. Если так, то предлагаю выполнить такой макрос:

Private Sub CommandButton1_Click()
    Dim a As String, i As Long, j As Long, arr(): Application.ScreenUpdating = False: Application.DisplayAlerts = False
    a = InputBox("ВВЕДИТЕ СТАТЬЮ", "ПОИСК СТАТЕЙ")
    If a = "" Then Exit Sub
    arr = ActiveSheet.UsedRange.Value
    On Error Resume Next: Sheets("NewSheet").Delete: On Error GoTo 0: Sheets.Add.Name = "NewSheet"
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = a Then
            j = Cells(Rows.Count, 1).End(xlUp).Row + 1: Range(Cells(j, 1), Cells(j, UBound(arr, 2))).Value = Application.Index(arr, i, 0)
        End If
    Next
End Sub

Если нужно, то можете сами добавить дальнейшие требуемые действия: сортировку, форматирование ячеек, заливку и т.п.

[Ilnour1986]

спасибо, попробую Ваш код!!!))
но вот ещё что, таблица может увеличиваться или уменьшаться(столбцы то больше, то меньше), вооот...
но надо чтоб поиск работал!
Очень жду помощи!

[SAS888]

таблица может увеличиваться или уменьшаться(столбцы то больше, то меньше)

Предлагаемый код ищет введенное пользователем значение в первом столбце (а как нужно?). При совпадении, на новый лист копируется вся строка, не зависимо от количества строк и столбцов.
Еще раз повторюсь, что для точного ответа сформулируйте точное задание и не экономьте слова.

[Ilnour1986]

1) Нужен поиск через Find тобишь если есть слова или предложения в диапзонах, где нужно искать, нужно чтобы выводило результат даже при вводе буквы(!) в поиске! ТО ЕСТЬ FIND ОБЯЗАТЕЛЕН(!)
2) вообще поиск по 3еум столбцу идёт, таблица оригинальная такая вот!
3) Спасибо за КОД! НО(!) результаты он НЕ выводит на другой лист, а выводит ПОД таблицу!!!

[SAS888]

Ну, вот видите, оказывается есть особенности задачи. Почему бы не оговорить их сразу?
Попробуйте такой вариант:

Private Sub CommandButton1_Click()
    Dim a As String, fst As String, i As Long, x As Range, y As Range
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    a = InputBox("ВВЕДИТЕ СТАТЬЮ", "ПОИСК СТАТЕЙ")
    If a = "" Then Exit Sub
    Set x = Columns(3).Find(what:=a, LookAt:=xlPart)
    If Not x Is Nothing Then
        fst = x.Address
        Do
            If y Is Nothing Then Set y = x Else Set y = Union(y, x)
            Set x = Columns(3).FindNext(x)
        Loop While fst <> x.Address
    End If
    If Not y Is Nothing Then
        On Error Resume Next: Sheets("NewSheet").Delete: On Error GoTo 0: Sheets.Add.Name = "NewSheet"
        y.EntireRow.Copy Sheets("NewSheet").[A1]
    End If
End Sub

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

[Ilnour1986]

СПАСИБО большое!!!))КОД РАБОТАЕТ))
учту ваш совет, постараюсь в след раз более яснее высказываться))у меня вопросов КУЧАА ещё!
КСтати, в новой созданном листе результат выводиться немного нет так как хотелось бы, то есть:
1) Нужно в первых строчках создать предложение "Результат поиска", чтоб красивее было, чем когда стандартно(шрифт, размер, цвет и т.д.)
2) чтобы результат выводился получше, не скомканно, то есть как в оригинальном листе! ваще такое реально сделать? так как в оригинальной таблице вместо, например, строки "НИОКР" написано "Статьи инвестирования НИОКР", а иногда этот НИОКР расшифровывается и получется широооокий столбец! в Итоге я хочу чтоб результат выводился как в оригенальной таблице!
3) там, где цифры, а это может быть НЕ 3 столбца, как тут в примере, а 10 или 100, и каждый раз меняются они в количеств6е! в результатах поиска снизу самих результатов нужен ИТОГО, то есть просчитать сумму вышестоящих ячеек каждого(!) столбца!

Очень надеюсь на Вашу помощь!
думаю мои условия ваще реально сделать на vba

[SAS888]

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