![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 and Office | Word | For home | Windows
A family of Microsoft word processing software products for creating web, email, and print documents.
The macro below can create the extra rows and move the parallel paragraphs into the new cells. Before you test it, confirm that the table meets these requirements:
- Each block (one boldface term and its definition) in both columns consists of exactly two paragraphs. The bold term is one paragraph, and the definition is one paragraph. If a definition consists of two or more paragraphs, replace their paragraph marks (except for the last one) with line breaks, Shift+Enter.
- There are no extra (blank) paragraph marks in the cells.
See https://www.gmayor.com/installing_macro.htm if needed.
When the macro finishes, you may want to turn off some or all of the table borders. To turn all of them off, the quick way is to press Ctrl+Alt+U. To turn off only the internal borders, use the Borders and Shading dialog (on the Table Design ribbon, click Borders and choose the last entry on the dropdown menu).
Sub SplitTable()
Dim tbl As Table
Dim intCol1Paras As Integer
Dim intCol2Paras As Integer
Dim intMovePara As Integer
Dim rg As Range
If Not Selection.Information(wdWithInTable) Then
MsgBox "Put the cursor in the table to work on, then rerun macro."
Exit Sub
End If
Set tbl = Selection.Tables(1)
intCol1Paras = tbl.Cell(1, 1).Range.Paragraphs.Count
intCol2Paras = tbl.Cell(1, 2).Range.Paragraphs.Count
If intCol1Paras <> intCol2Paras Then
MsgBox "The numbers of paragraphs in the two columns are not equal." _
& vbCr & "Make them equal and rerun the macro." & vbCr & _
"You may need to replace some paragraph marks with line breaks."
Exit Sub
End If
If intCol1Paras Mod 2 = 1 Then
MsgBox "The numbers of paragraphs in the two columns are not even." _
& vbCr & "Make them even and rerun the macro." & vbCr & _
"You may need to replace some paragraph marks with line breaks."
End If
For intMovePara = 3 To intCol1Paras - 1 Step 2
tbl.Rows.Add ' defaults to end of table
Set rg = tbl.Cell(1, 1).Range.Paragraphs(3).Range
rg.MoveEnd wdParagraph, 1
If rg.End = tbl.Cell(1, 1).Range.End Then rg.MoveEnd wdCharacter, -1
tbl.Cell(tbl.Rows.Count, 1).Range.FormattedText = rg.FormattedText
rg.Select
rg.Delete
Set rg = tbl.Cell(1, 2).Range.Paragraphs(3).Range
rg.MoveEnd wdParagraph, 1
If rg.End = tbl.Cell(1, 2).Range.End Then rg.MoveEnd wdCharacter, -1
tbl.Cell(tbl.Rows.Count, 2).Range.FormattedText = rg.FormattedText
rg.Select
rg.Delete
Next intMovePara
End Sub
