Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, r As Long, c As Long
With ActiveDocument.Tables(1)
  If .Columns.Count * .Rows.Count > 63 Then
    MsgBox "Too many cells - 63 is the maximum supported", vbCritical
    Exit Sub
  End If
  For c = .Columns.Count To 1 Step -1
    For r = .Rows.Count To 2 Step -1
      If c = .Columns.Count Then
        .Columns.Add
      Else
        .Columns.Add .Columns(c + 1)
      End If
      Set Rng = .Cell(r, c).Range
      Rng.End = Rng.End - 1
      .Cell(1, c + 1).Range.FormattedText = Rng.FormattedText
    Next
  Next
  For r = .Rows.Count To 2 Step -1
    .Rows(r).Delete
  Next
End With
Application.ScreenUpdating = True
End Sub