Sub join_cells()
Dim arr, i As Long, res() As String, j As Long, lr As Long, app
On Error GoTo errorH ' в случае ошибки выходим из процедуры
With Worksheets("Лист3") ' Лист3 - поменять на Ваш лист с таблицей
    ' определяем последнюю заполненную ячейку на листе Лист3
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    ' загружаем всю таблицу в массив
    arr = .Range("A2:E" & lr): j = 2 ' j - это счетчик для массива res(). _
    диапазон начинается с А2, то есть без шапки
    For i = LBound(arr, 1) To UBound(arr, 1) ' цикл по массиву arr
        ReDim Preserve res(2 To j) ' меняем размерность массива до j
        res(j) = arr(i, 3) & " " & arr(i, 5) ' записываем значение в массив
        j = j + 1 ' увеливчивваем счетчик на 1
    Next i
    
' отключаем отслеживание событий
app = Application.EnableEvents
' выгрузка результата на лист в столбец D, начиная со 2-й строки
    For i = 2 To lr
        .Cells(i, 4) = res(i)
    Next i
' включаем отслеживание событий
Application.EnableEvents = app
End With
Exit Sub
errorH:
End Sub