Sub Поиск()
  Dim searchValue As String
  Dim cell As Range, out(), ct&
  Dim result As String
  Dim searchRange As Range
  ' Получаем значение для поиска из ячейки B6
  searchValue = ThisWorkbook.Sheets("Поиск").Range("B6").Value
  ' Указываем диапазон для поиска
  Set searchRange = ThisWorkbook.Sheets("Все статьи").Range("C1:C20")
  ReDim out(1 To searchRange.Rows.Count, 1 To 2) '#дополняем размерность 2-го индекса
  ' Инициализируем переменную для хранения результата
  result = ""
  ' Проходим по каждой ячейке в указанном диапазоне
  For Each cell In searchRange
    If InStr(1, cell.Value, searchValue, vbTextCompare) > 0 Then
      ' Если найдено совпадение, добавляем значение в результат
      ct = ct + 1
      out(ct, 1) = cell.Value
      out(ct, 2) = cell.Offset(, 1).Value '#значение из соседнего столбца в массив
    End If
  Next cell
  ' Выводим найденные значения в ячейку B10
  If ct > 0 Then
    With ThisWorkbook.Sheets("Поиск")
      .Range("B10", .Range("B10").End(xlDown)).ClearContents
      .Range("B10").Resize(ct, 2) = out '#расширяем диапазон вывода на один столбец
      ' Выделяем ячейки светло-жёлтым цветом
      With .Range("B10").Resize(ct, 2)
        .Interior.Color = RGB(255, 255, 204) ' Светло-жёлтый цвет
        ' Добавляем границу
        With .Borders
          .LineStyle = xlContinuous
          .Color = RGB(0, 0, 0) ' Чёрный цвет границы
          .Weight = xlThin
        End With
      End With
    End With
  End If
End Sub