Sub TestTables()
Dim t As Long, c As Long, x As Long, y As Long, z As Long, StrTbls As String
With ActiveDocument
  For t = 1 To .Tables.Count
    With .Tables(t)
      If .Uniform = True Then
        z = .Columns.Count
        If z = x Then StrTbls = StrTbls & ", " & t
        If z > x Then x = z: StrTbls = t
      Else
        z = 0
        With .Range
          For c = 1 To .Cells.Count
            y = .Cells(c).ColumnIndex
            If y >= x Then z = y
          Next
        End With
        If z = x Then StrTbls = StrTbls & ", " & t
        If z > x Then x = z: StrTbls = t
      End If
    End With
  Next
End With
MsgBox "The most columns (" & x & ") are found in table(s): " & StrTbls
End Sub