Поиск по определенному признаку и склеивание строк

Sub TwarePoPare()
Dim even As Boolean 'счётчик (датчик) чётности найденного
Selection.HomeKey wdStory 'перевод курсора в начало документа Word
 
With Selection
    'ниже три настройки диалога замены (который по CTRL h)
    .Find.Text = "[^11^13]" '11 - код разрыва строки; 13 - абзаца
    .Find.Replacement.Text = "" 'пустое место в окне «Заменить на:»
    .Find.MatchWildcards = True 'подстановочные знаки ВКЛ.
    .Find.Execute
    Do While .Find.Found 'пока находим
        even = Not even 'расчёт на "первый-второй"
            If even Then
                .Find.Execute Replace:=wdReplaceOne  'первый - меняем на ""
            Else
                .Find.Execute Replace:=wdReplaceNone 'второй - оставляем
                .Collapse Direction:=wdCollapseEnd  'сняли с него выделение
            End If
        If Selection.Range.Paragraphs.Count = ActiveDocument.Paragraphs.Count _
        Then Exit Do 'выход из цикла на последнем абзаце
    Loop
End With
    
End Sub

Sub EschoWare()
    Dim rng As Range, arr(), arr1(), i As Long
    Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    arr = rng
    ReDim arr1(1 To UBound(arr) / 2, 1 To 1)
    For i = 2 To UBound(arr) Step 2
        arr1(i / 2, 1) = arr(i - 1, 1) & " " & arr(i, 1)
    Next
    Range("B1").Resize(UBound(arr1)) = arr1
End Sub