Для разнообразия Результат одинаков
Код:
Sub ParagraphToRow()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long, bFnd As Boolean
For Each Tbl In ActiveDocument.Tables
With Tbl
r = 1
rc = .Rows.Count
Do While r < rc
With .Rows(r).Range.Find
.Text = "^p"
.Execute
bFnd = .Found
End With
If bFnd = True Then
.Rows.Add .Rows(r)
For c = 1 To .Columns.Count
'If .Cell(r + 1, c).Range.Paragraphs.Count > 1 Then
.Cell(r, c).Range.Text = Split(.Cell(r + 1, c).Range.Text, vbCr)(0)
.Cell(r + 1, c).Range.Paragraphs(1).Range.Text = vbNullString
'End If
Next
End If
r = r + 1
rc = .Rows.Count + 1
Loop
End With
Next
Application.ScreenUpdating = True
End Sub