Sub Поиск_С_Фильтрацией()
Dim searchValue As String
Dim period As String
Dim foundCell As Range
Dim firstAddress As String
Dim wsData As Worksheet
Dim wsSearch As Worksheet
Dim resultRow As Long
Dim lastRow As Long
Dim dateFilter As Date

' Определяем рабочие листы
Set wsData = ThisWorkbook.Worksheets("данные")
Set wsSearch = ThisWorkbook.Worksheets("поиск")

' Очищаем предыдущую область результатов
With wsSearch.Range("A15:Z1000")
.ClearContents
.ClearFormats
End With

' Получаем значение для поиска
searchValue = wsSearch.Range("D7").Value
period = wsSearch.Range("E7").Value

' Определяем дату фильтра
Select Case period
Case "1 месяц"
dateFilter = Date - 30
Case "2 месяца"
dateFilter = Date - 60
Case "3 месяца"
dateFilter = Date - 90
Case "6 месяцев"
dateFilter = Date - 180
Case "за все время"
dateFilter = "01.01.1900"
End Select

' Начинаем поиск (частичное совпадение)
With wsData.Columns("B")
Set foundCell = .Find(What:="*" & searchValue & "*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not foundCell Is Nothing Then
firstAddress = foundCell.Address
resultRow = 15 ' Начальная строка для вывода результатов

Do
' Проверяем соответствие дате
If wsData.Cells(foundCell.Row, "P") >= dateFilter Then
' Копируем найденную строку на лист "поиск"
wsData.Rows(foundCell.Row).Copy _
Destination:=wsSearch.Cells(resultRow, 1)

' Удаляем заливку у скопированных строк
wsSearch.Cells(resultRow, 1).EntireRow.Interior.ColorIndex = xlNone
resultRow = resultRow + 1
End If

Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress

' Сортируем результаты по дате (столбец P) от поздних к ранним
lastRow = wsSearch.Cells(wsSearch.Rows.Count, 1).End(xlUp).Row
wsSearch.Range("A15:P" & lastRow).Sort _
Key1:=wsSearch.Range("P15"), _
Order1:=xlDescending, _
Header:=xlNo

If lastRow = 14 Then
wsSearch.Range("A15") = "Ничего не найдено"
End If

Else
wsSearch.Range("A15") = "Ничего не найдено"
End If
End With
End Sub