For example:
Sub Demo()
Application.ScreenUpdating = False
Dim xlObj As Object
With ActiveDocument
.ConvertNumbersToText (wdNumberAllNumbers)
With .Range
Do While .Characters.Last.Previous = vbCr
.Characters.Last.Previous.Delete
Loop
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Wrap = wdFindContinue
.Text = "^p"
.Replacement.Text = Chr(182)
.Execute Replace:=wdReplaceAll
.Text = "^t"
.Replacement.Text = Chr(32)
.Execute Replace:=wdReplaceAll
End With
.Copy
End With
End With
Set xlObj = GetObject(, "Excel.Application")
With xlObj.Activesheet
.Paste Destination:=.Range("A1")
.Range("A1").Replace Chr(182), Chr(10), 2, 1
End With
Set xlObj = Nothing
Application.ScreenUpdating = True
End Sub