Вверху модуля вставьте эти строки:
Option Explicit
Option Compare Text
Option Base 1
Макрос
Sub Макрос()
Dim компании(), что(), где(), рез()
Dim сборник As String
Dim lr As Long, i As Long, ii As Long
'1. Копируем данные из столбцов в vba-массивы: с vba-массивами макрос
' быстрее работает, чем с эксель-ячейками.
' Поиск последней строки.
' End не ищет в скрытых строках.
lr = Cells(Rows.Count, "E").End(xlUp).Row
' Копирование столбца в массив.
что() = Range("E4:E" & lr).Value
lr = Cells(Rows.Count, "G").End(xlUp).Row
где() = Range("G4:G" & lr).Value
компании() = Range("A4:A" & lr).Value
'2. Создание ячеек в массиве-результате: сначала в него запишутся данные,
' а затем он будет вставлена на лист. Возможно это ускорит макрос.
' Также это может быть упростит чтение кода.
ReDim res(UBound(что), 1)
'3. Заполнение массива "res".
' Движение по строкам массива "что".
For i = 1 To UBound(что)
'1) Если в ячейке троеточие, то переходим на следующую строку.
If что(i, 1) = "---" Then
GoTo СледСтрока
End If
'2) Сброс переменной от предыдущего витка цикла.
сборник = ""
'3) Движение по строкам массива "где".
For ii = 1 To UBound(где)
' Если данные в двух ячейках одинаковые, то запись данных в переменную "сборник".
' Данные записываются в конец переменной "сборник".
If где(ii, 1) = что(i, 1) Then
сборник = сборник & компании(ii, 1) & Chr(10)
End If
Next ii
'4) Копирование данных из переменной "сборник" в массив "res".
' Если в переменной есть данные.
If сборник <> "" Then
' Удаление с конца заранее вставленного символа "новая строка".
сборник = Left(сборник, Len(сборник) - 1)
' Запись данных в массив.
res(i, 1) = сборник
End If
СледСтрока:
Next i
'4. Вставка массива на лист.
Range("K4").Resize(UBound(res)).Value = res()
'5. Сообщение.
MsgBox "Готово.", vbInformation
End Sub