Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Word.Table
Dim lngTable As Long
Dim lngIndex As Long, lngRow As Long, lngCount As Long
Dim arrCounts() As String
Dim oRng As Range
Dim oDoc As Document
Dim lngComp As Long
  For lngTable = 1 To ActiveDocument.Tables.Count
    lngComp = lngComp + (ActiveDocument.Tables(lngTable).Rows.Count - 1)
  Next lngTable
  ReDim arrCounts(1 To lngComp, 1 To 3)
  lngComp = 0
  For lngTable = 1 To ActiveDocument.Tables.Count
    Set oTbl = ActiveDocument.Tables(lngTable)
    For lngRow = 2 To oTbl.Rows.Count
      lngComp = lngComp + 1
      If lngRow = 2 Then
        Set oRng = oTbl.Cell(lngRow, 1).Range
        oRng.End = oRng.End - 1
        arrCounts(lngComp, 1) = oRng.Text
      End If
      Set oRng = oTbl.Cell(lngRow, 2).Range
      oRng.End = oRng.End - 1
      arrCounts(lngComp, 2) = oRng.Text
      Set oRng = oTbl.Cell(lngRow, oTbl.Columns.Count).Range
      oRng.End = oRng.End - 1
      arrCounts(lngComp, 3) = oRng.ComputeStatistics(wdStatisticWords)
    Next lngRow
  Next lngTable
lbl_Exit:
  Set oDoc = Documents.Add
  Set oTbl = oDoc.Tables.Add(oDoc.Range, UBound(arrCounts), 3)
  For lngIndex = 1 To UBound(arrCounts)
    oTbl.Cell(lngIndex, 1).Range.Text = arrCounts(lngIndex, 1)
    oTbl.Cell(lngIndex, 2).Range.Text = arrCounts(lngIndex, 2)
    oTbl.Cell(lngIndex, 3).Range.Text = arrCounts(lngIndex, 3)
  Next
  Exit Sub
End Sub