'запускать при активном листе Лист1
Sub iValue()
Dim i As Long
Dim iLastRow As Long
Dim FoundValue As Range
Dim FAdr As String
Dim j As Integer
With Worksheets("РЕЗУЛЬТАТ")
 .Cells.Clear
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("A1:A" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
 iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
      For i = 2 To iLastRow
        Set FoundValue = Columns(1).Find(.Cells(i, "A"), , xlValues, xlWhole)
         If Not FoundValue Is Nothing Then
            FAdr = FoundValue.Address
            j = 2
          Do
           .Cells(i, j) = Cells(FoundValue.Row, "B")
           Set FoundValue = Columns(1).FindNext(FoundValue)
            j = j + 1
          Loop While FoundValue.Address <> FAdr
         End If
      Next
End With
End Sub