Макрос - цикличный поиск ячеек и вывод соседних строк

[Глеб]

Макрос - цикличный поиск ячеек и вывод соседних строк

Есть таблица Excel // 2 колонки  А - люди и В - вид роботы
нужно найти в колонке все имена ,например Максим, и  скопировать соседние ячейки, а затем вывести их в строчку рядом


За моим  макросом, посик  выполняется только 1 раз, выводится только первое значение.


Как сдеть поиск по всему столбику, что бы в итоге напротив имени было в строчку несколько видов выполненной роботы?
смотрите вложенный файл и скриншот


А             В
имя      вид роботы

глеб      в р
лиля           дз
глеб           з г
максим   цв
денис           дз
лиля           з г
лиля           з г
максим   з г
максим   з г
максим   цв
света           з г
максим   цв

______________

хочу добиться результата, вывод поиска такой

Максим   цв  зг   зг  цв цв
______________


мой мкрос
Sub sieg()

Worksheets("Лист1").Activate 'переходим к файлу книга 1

   x = "максим"

   c = Cells.Find(What:=x).Column ' определяем номер столбеца в котором нужное значение
   r = Cells.Find(What:=x).Row 'определяем номер строки в котором нужное значение
   f = Cells(r, c + 1).Value 'запоминаем значение ячейки справа от искомой

   
    Worksheets("Лист1").Activate 'переходим к файлу книга 1
    Cells(37, 7).Value = f 'вставляем в ячейку с адресом

End Sub


буду безмерно  благодарен за помощь

[kuklp]

Код Выделить Развернуть

Public Sub www()
    Dim a, i&
    Application.DisplayAlerts = 0
    a = [a4].CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                .Item(a(i, 1)) = .Item(a(i, 1)) & "|" & a(i, 2)
            Else
                .Item(a(i, 1)) = a(i, 2)
            End If
        Next
        [f36].Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
    End With
    Range("G36:G" & Cells(Rows.Count, 7).End(xlUp).Row).TextToColumns _
            [G36], DataType:=xlDelimited, Other:=True, OtherChar:="|"
    Application.DisplayAlerts = -1
End Sub