Как можно объединить несколько строк в одну ячейку с помощью ссылочной ячейки в VBA?

Question

Ссылка на рабочую книгу: https://ufile.io/gm0fn

У меня есть макрос-код VBA, который возвращает результаты поиска по заданным критериям поиска с использованием синтаксиса автофильтра.

Целью этого кода является поиск результатов в литературе и возврат всех результатов непосредственно в Excel.

Проблема, с которой я сталкиваюсь, заключается в том, что текущий код просто перечисляет всех авторов во всей таблице результатов поиска и перечисляет их в столбце A, по одному автору за раз.

Для каждого заголовка есть несколько авторов, поэтому я хотел бы использовать функцию, чтобы объединить все результаты авторов для соответствующего заголовка статьи в одну ячейку.

Как изменить текущий код, чтобы использовать последнюю ячейку, обозначенную "SO", как точку отсчета, чтобы объединить всех авторов в строку и вернуть их в одну ячейку.

Пожалуйста, обратитесь к изображениям, чтобы понять, что я пытаюсь сделать.Любые идеи очень приветствуются.

Sub ReturnFAUResults()

    Dim r As Range

    Application.ScreenUpdating = True

    With Worksheets("Sheet1") ' reference results sheet
        If IsEmpty(.Range("A1")) Then .Range("A1").Value = "dummy header" ' if A1 is empty, put a "dummy" header to make AutoFilter work properly

        .AutoFilterMode = False
        With .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Offset(, -1) ' reference referenced sheet column A range from row 1 down to column B last not empty cell
            .SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C" ' fill referenced range blank cells with the same value as the not empty cell above
            .AutoFilter Field:=1, Criteria1:="=FAU"
            On Error Resume Next
            Set r = .Resize(.Rows.Count - 1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not r Is Nothing Then r.Copy Worksheets("Search Results").Range("A7")
            .Parent.AutoFilterMode = False

            .SpecialCells(xlCellTypeFormulas).ClearContents ' clear cell with formulas
            If .Range("A1").Value = "dummy header" Then .Range("A1").ClearContents ' remove any "dummy" header
        End With
    End With

Application.ScreenUpdating = True
End Sub