Sub test()
    Dim dic As Object, txt$, ikey, iarr$()
    Dim arr(), i&, j&, i_dic As Object
    
    Set dic = CreateObject("Scripting.Dictionary")
    Set i_dic = CreateObject("Scripting.Dictionary")
    arr = Worksheets("До").UsedRange.Value
    For i = 2 To UBound(arr)
        If Not IsEmpty(arr(i, 1)) Then
            For j = 2 To UBound(arr, 2)
                txt = arr(i, 1) & "|" & arr(i, j)
                dic.Item(txt) = 0
            Next j
        End If
    Next i
    For Each ikey In dic.keys
        iarr = Split(ikey, "|")
        i_dic.Item(iarr(0)) = i_dic.Item(iarr(0)) & iarr(1) & "|"
    Next ikey
    Worksheets("После").Cells.Clear
    For Each ikey In i_dic.keys
        With Worksheets("После")
            .[a1].Resize(, 2) = Array("Фраза", "URL [Google]")
            i = .Range("b" & .Rows.Count).End(xlUp).Row + 1
            iarr = Split(i_dic.Item(ikey), "|")
            .Range("a" & i).Value = ikey
            .Range("b" & i).Resize(UBound(iarr)).Value = Application.Transpose(iarr)
        End With
    Next ikey
End Sub