Take a look at MergeCells method in the Help file
Here is my old one I don't remember how it worked
Sub Merge_Cells()
Dim oSpace As AcadBlock
Set oSpace = ThisDrawing.ModelSpace
Dim pt(2) As Double
Dim oTable As AcadTable
Set oTable = oSpace.AddTable(pt, 4, 4, 1, 7)
ZoomExtents
Dim i As Long, j As Long
oTable.TitleSuppressed = True
oTable.HeaderSuppressed = True
For i = 0 To oTable.Rows - 1
For j = 0 To oTable.Columns - 1
oTable.SetCellType i, j, acTextCell
oTable.SetCellTextHeight i, j, 0.4
oTable.SetCellAlignment i, j, acMiddleCenter
oTable.SetText i, j, "Row " & CStr(i) & ": Column 0"
Next j
Next i
For i = 1 To oTable.Rows - 2
oTable.MergeCells i, i, 0, 3
Next
For i = 0 To oTable.Columns - 1
oTable.SetText oTable.Rows - 1, i, "Row " & CStr(oTable.Rows - 1) & ": Column " & CStr(i)
Next
oTable.RecomputeTableBlock True
oTable.Update
End Sub
~'J'~