Dim arrTemp() As Integer

Sub uuu()
    Dim a(), b()
    Dim i&, j&
    Dim s$
'--------------
    s = Sheets("Лист1").Cells(2, 1) 'запоминаем искомую фразу
    a = Sheets("Рейсы").UsedRange.Value 'берём диапазон с листа рейсы в массив
    For i = 1 To UBound(a) 'проходим по начальному массиву
        If a(i, 4) = s Then 'если совпадает искомая фраза и значение элемента массива то
            j = j + 1 'увеличиваем счётчик элементов итогового массива
            ReDim Preserve b(1 To j) 'изменяем размер массива с сохранением данных
            b(j) = a(i, 1) 'вносим в итоговый массив значение из базового массива
        End If
    Next
    'выводим сообщение, собирая элементы итогового массива в строку с переносом строки - чтобы ваще круто было
    MsgBox Join(b, Chr(10))
End Sub