T-Belle
This mod of Andrews code will come close with your attached. However, the merges cells that span a page aren't split.
Code:
Sub ProcTbls()
Dim oTbl As Table, oNT As Table
For Each oTbl In ActiveDocument.Tables
SplitVMCs oTbl
For Each oNT In oTbl.Tables
SplitVMCs oNT
Next oNT
Next oTbl
lbl_Exit:
Exit Sub
End Sub
Sub SplitVMCs(oTbl As Table)
Dim oCell As Cell, oRng As Range
Dim lngRow As Long, lngSplit As Long
If Not oTbl.Uniform Then
For Each oCell In oTbl.Range.Cells
If oCell.RowIndex = oTbl.Rows.Count Then Exit For
Set oRng = oCell.Range
oRng.Select
Selection.MoveDown Unit:=wdLine, Count:=1
On Error GoTo Err_Cell
If Selection.Information(wdWithInTable) Then
lngSplit = Selection.Cells(1).RowIndex - oRng.Cells(1).RowIndex
Else
lngSplit = oTbl.Rows.Count - oRng.Cells(1).RowIndex + 1
End If
Err_RE:
If lngSplit > 1 Then oCell.Split NumRows:=lngSplit
Next oCell
End If
lbl_Exit:
Exit Sub
Err_Cell:
lngSplit = 1
Resume Err_RE
End Sub