The word tables having variable number of rows and columns. The below code I have taken from previously answered in this forum and try to modify it. However, due lack of knowledge I could find or able to edit it further.
Few rows in table having paragraph break (¶) marked in yellow color in image and in same row few texts with space marked in green color.
I have try to find rows for paragraph break. If found, add row below and split content in to two rows. Below images, explain details. The below table images presented by Turn formatting marks on.
First row having variable width. Hence, find from row 2 to last rows, as remaining rows are similar. The first three columns remains constant.
similar post found but not split row content (MS Word table -macro to find row containing specific text then move entire row to last row in the table). I have try to find "^p".
The 4 to last column having paragraph break in any row. The new row added after and duplicate content of above row and then split. The column 1 to 3 have space between text.
Similar post Moving down a row in a Word table containing multi-paragraph cells But not working in mixed width table.
Sub FindParagraph()
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = False
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then
'Don not know code.
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End Sub
I doubt the macro recorder will be much help here. Try:
Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, c As Long, bFnd As Boolean
For Each Tbl In ActiveDocument.Tables
With Tbl
For r = .Rows.Count To 2 Step -1
With .Rows(r).Range.Find
.Text = " "
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
.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
Next
End With
Next
Application.ScreenUpdating = True
End Sub