Move Existing Rows to TBody 

Sub RowsToTBodyRowsMove()
  On Error GoTo errHandler1:
  Dim strHTML As String
  Dim strInnerHTML As String

  'Put existing HTML into String variable.
  strInnerHTML = ActiveDocument.all. _
  tags("table").Item(0).innerHTML

  'Put blank line in front of strInneHTML
  'for tab control.
  strInnerHTML = vbCrLf & strInnerHTML

  'Delete the existing table
  ActiveDocument.all.tags("table"). _
  Item(0).innerHTML = ""

  'set HTML for TBody element.
  strHTML = _
  vbCrLf & _
  vbTab & _
  vbTab & _
  "<tbody>" & _
  vbCrLf & _
  vbCrLf & _
  vbTab & _
  vbTab & _
  "</tbody>" & _
  vbCrLf

  'insert HTML for new TBody element
  ActiveDocument.all.tags("table"). _
  Item(0).insertAdjacentHTML _
  "BeforeEnd", strHTML

  'Save the changes.
  WebDesigner.ActivePageWindow.Save True


  'find the index number of the new TBody
  'Index value will be last table or length
  tbodycount = ActiveDocument.all.tags("table"). _
  Item(0).Children.tags("tbody").Length


  'Put the old table contents inside the
  'new BodyElement element
  ActiveDocument.all.tags("table").Item(0). _
  Children.tags("tbody").Item(tbodycount - 1). _
  insertAdjacentHTML "afterBegin", strInnerHTML

  'Save the Changes
  WebDesigner.ActivePageWindow.Save True

  Exit Sub

errHandler1:
  MsgBox "RowsToTbodyRowsMove has failed.", _
  vbCritical, "Function Failure"

End Sub