Public Sub Paste_CellsSurrounding() ' Буфер > Вставить > Ячейки > Формат: использовать соседний

    On Error Resume Next
    ' первая целевая ячека
Dim C1 As Word.Cell

    Err.Clear
    Set C1 = Selection.Cells(1)
    If Err.Number <> 0 Then Exit Sub
    ' блокируем интерфейс
Dim B As Boolean

    B = Application.ScreenUpdating
    If B Then Application.ScreenUpdating = False
    ' вставка во временный документ
    
Dim D As Word.Document
    
    Set D = Application.Documents.Add( _
                DocumentType:=wdNewBlankDocument, _
                Visible:=False)
    D.Range.Paste ' AndFormat Type:=Word.wdFormatOriginalFormatting
    ' первая исходная ячейка
Dim C2 As Word.Cell
    
    Err.Clear
    Set C2 = D.Range.Cells(1)
    If Err.Number = 0 Then
        ' перенос ячеек
        Do
            ' копируем
            With C2.Range
                .MoveEnd Unit:=Word.wdCharacter, Count:=-1
                .Copy
            End With
            ' вставляем
            With C1.Range
                .MoveEnd Unit:=Word.wdCharacter, Count:=-1
                .PasteAndFormat Type:=Word.wdFormatSurroundingFormattingWithEmphasis
            End With
            ' следующая пара
            Set C1 = C1.Next
            If C1 Is Nothing Then Exit Do
            Set C2 = C2.Next
            If C2 Is Nothing Then Exit Do
        Loop
    End If
    ' закрываем временный
    D.Close SaveChanges:=False
    ' разблокируем интерфейс
    If B Then Application.ScreenUpdating = True
    
End Sub

Public Sub Paste_CellsSurrounding() ' Буфер > Вставить > Ячейки > Форма: использовать соседний

    On Error Resume Next
    ' первая целевая ячека
Dim C1 As Word.Cell

    Err.Clear
    Set C1 = Selection.Cells(1)
    If Err.Number <> 0 Then Exit Sub
    ' готовим интерфейс
Dim B As Boolean
Dim V As Word.WdViewType

    B = Application.ScreenUpdating
    If B Then Application.ScreenUpdating = False
    With ActiveDocument.ActiveWindow.ActivePane.View
        V = .Type
        If V <> Word.wdNormalView Then .Type = Word.wdNormalView
    End With
    ' вставка во временный документ
    
Dim D As Word.Document
    
    Set D = Application.Documents.Add( _
                DocumentType:=wdNewBlankDocument, _
                Visible:=False)
    D.Range.Paste ' AndFormat Type:=Word.wdFormatOriginalFormatting
    ' первая исходная ячейка
Dim C2 As Word.Cell
Dim S As String

    Err.Clear
    Set C2 = D.Range.Cells(1)
    If Err.Number = 0 Then
        ' перенос ячеек
        Do
            ' копируем
            With C2.Range
                .MoveEnd Unit:=Word.wdCharacter, Count:=-1
                S = .Text ' .Copy
            End With
            ' вставляем
            With C1.Range
                .MoveEnd Unit:=Word.wdCharacter, Count:=-1
                .Text = S '.PasteAndFormat Type:=Word.wdFormatSurroundingFormattingWithEmphasis
            End With
            ' следующая пара
            Set C1 = C1.Next
            If C1 Is Nothing Then Exit Do
            Set C2 = C2.Next
            If C2 Is Nothing Then Exit Do
        Loop
    End If
    ' закрываем временный
    D.Close SaveChanges:=False
    ' восстанавливаем интерфейс
    With ActiveDocument.ActiveWindow.ActivePane.View
        If V <> Word.wdNormalView Then .Type = V
    End With
    If B Then Application.ScreenUpdating = True
    
End Sub