Nice work Greg. I was hoping you could find a way of avoiding Selection though
The code I posted failed because of three factors I see in your posted example:
1. Nested tables were ignored
1a. Nested tables 'selection below' is still inside a table
2. Inconsistent row lengths
3. Spans across page breaks
Greg's code has solved most of these but the 1a issue causes the last row in the nested table to get ignored. We can avoid Greg's error handling workaround if we include another If statement to test for shorter row lengths and also change the method to determine whether moving selection down is still inside the table under review.
Code:
Sub Tables2Levels()
Dim aTbl As Table, aTblinner As Table
Dim lngView As Long
lngView = ActiveDocument.ActiveWindow.View
ActiveDocument.ActiveWindow.View = wdNormalView
For Each aTbl In ActiveDocument.Tables
SplitVertMergeCells aTbl
For Each aTblinner In aTbl.Tables 'process the first level nested tables as well
SplitVertMergeCells aTblinner
Next aTblinner
Next aTbl
ActiveDocument.ActiveWindow.View = lngView
End Sub
Sub SplitVertMergeCells(aTbl As Table)
Dim aCell As Cell, i As Integer, aRng As Range
Dim iRow As Integer, iCol As Integer, iSplit As Integer
If Not aTbl.Uniform Then
For Each aCell In aTbl.Range.Cells
If aCell.RowIndex = aTbl.Rows.Count Then Exit For
Set aRng = aCell.Range
aRng.Select
Selection.MoveDown Unit:=wdLine, Count:=1
If Selection.Range.End < aTbl.Range.End Then
If Selection.Information(wdAtEndOfRowMarker) Then 'table has inconsistent row lengths
iSplit = 1
Else
iSplit = Selection.Cells(1).RowIndex - aRng.Cells(1).RowIndex
End If
Else
iSplit = aTbl.Rows.Count - aRng.Cells(1).RowIndex + 1
End If
If iSplit > 1 Then aCell.Split NumRows:=iSplit
Next aCell
End If
End Sub