microsoft.public.word.vba.general

Here's a range version.

Sub Main3()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim tr As HTMLTableRow
Dim td As HTMLTableCell
Dim tbl As HTMLTable
Dim blc As HTMLBlockElement
Dim doctbl As Table
Dim nrow As Integer
Dim i As Integer, x As Integer
Dim Rng As Range
Dim myrange As Range
Dim A As Integer
Dim NavPages As Variant
Dim WebSiteAdd As String
Dim TeamNames As String
Dim TeamArray As Variant
Dim TS As TabStop

Set ie = CreateObject("InternetExplorer.Application")

ie.Visible = False
'***** This sets the web page to access:
'Premier

WebSiteAdd = "http://www.skysports.com/football/league/
0,19540,11660,00.html;" & _
"http://www.skysports.com/football/league/0,19540,11687,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11718,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11749,00.html;"
& _
"http://www.skysports.com/football/league/0,19540,11780,00.html"
NavPages = Split(WebSiteAdd, ";")

For A = 0 To UBound(NavPages)

ie.Navigate NavPages(A)

'Premier "http://www.skysports.com/football/league/
0,19540,11660,00.html"
'Championship "http://www.skysports.com/football/league/
0,19540,11687,00.html"
'League1 "http://www.skysports.com/football/league/
0,19540,11718,00.html"
'League2 "http://www.skysports.com/football/league/
0,19540,11749,00.html"
'Scottish Premier "http://www.skysports.com/football/league/
0,19540,11780,00.html"

'Give user some feedback.
Application.StatusBar = "Fetching website " & A + 1
Do
'MsgBox "Looking up data on Skysports...", , "Collecting Data"
'***** MC - wait until internet page has completed loading
DoEvents
Loop While ie.readyState <> READYSTATE_COMPLETE

Set doc = ie.Document

'this searches for the element name - eg table id="ss-stat-sort"
Set tbl = doc.getElementById("ss-stat-sort")

'"ss-stat-sort" is the html code on this page
nrow = tbl.Rows.Length - 1

'this looks for the tag " in the html code
Set blc = tbl.all.tags("caption").Item(0)

'***** MC - insert the table title bar
'outerText = Returns or sets a String that represents the text,
'without any HTML, of a DIV element
Set Rng = ActiveDocument.Range
Rng.InsertAfter blc.outerText

'***** MC - this part selects for 10 columns
'Collapse rng to end of document
'Set Rng = ActiveDocument.Range
Rng.Collapse direction:=wdCollapseEnd
'Add table
Set doctbl = ActiveDocument.Tables.Add(Rng, nrow, 10)

'***** MC - select no of teams to show from the top - for top 10 type
-11 here,
' else type -1 default
x = tbl.Rows.Length - 1

Dim col As Integer, j As Integer
For i = 2 To x
Set tr = tbl.all.tags("tr").Item(i)
col = tr.all.tags("td").Length - 2
For j = 2 To col
Set td = tr.all.tags("td").Item(j)
doctbl.Cell(i, j).Range.Text = td.outerText
Next
DoEvents

'***** MC - above code inserts the data for first row -
'the 'next' code below loops through rest of the rows and repeats

Next

'ActiveDocument.Tables(1).Columns(1).Delete
Application.StatusBar = "Converting table of " & blc.outerText

'Insert the header titles
With ActiveDocument.Tables(1)
.Columns(1).Delete
.Cell(Row:=1, Column:=1).Range.Text = "Team"
.Cell(Row:=1, Column:=2).Range.Text = "Pld"
.Cell(Row:=1, Column:=3).Range.Text = "W"
.Cell(Row:=1, Column:=4).Range.Text = "D"
.Cell(Row:=1, Column:=5).Range.Text = "L"
.Cell(Row:=1, Column:=6).Range.Text = "GF"
.Cell(Row:=1, Column:=7).Range.Text = "GA"
.Cell(Row:=1, Column:=8).Range.Text = "GD"
.Cell(Row:=1, Column:=9).Range.Text = "Pts"
'Change the whole table to 6pt
.Range.Font.Size = 6
'Change the header row to 8pt
.Rows(1).Range.Font.Size = 8
.Rows(1).Range.Font.Bold = True
'Convert table to text
.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
End With

With ActiveDocument.Range
.Collapse wdCollapseEnd
.InsertAfter vbCr & vbCr
.Collapse wdCollapseEnd
End With

'This is the end of the loop that collects all the data and inserts
the table.
Next A

'Now let's clean up the table
'Look through all football team names and shorten as required
'Manchester > Man
'United > Utd
'Rovers > -
'Hotspur > -
'Wanderers > -
'Wolverhampton Wanderers > Wolves
'Athletic > -
'Birmingham City > Birmingham
'Wycombe Wanderers - Wycombe

'First Name is the searched string, the second is the replacement.
'If there are two commas, then the replacement string is ""
TeamNames$ = "Manchester,Man,Wolverhampton Wanderers,Wolves," & _
"Birmingham City,Birmingham,Wycombe Wanderers,Wycombe," & _
"Dagenham & Redbridge,Dagenham & R,Rotherham United,Rotherham," &
_
"Accrington Stanley,Accrington S,Shrewsbury Town,Shrewsbury," & _
"Macclesfield Town,Macclesfield,Mansfield Town,Mansfield," & _
"Peterborough United,Peterborough, Dons,,Country,C," & _
"West Bromwich Albion,WBA, Argyle,,Queens Park Rangers,QPR," & _
" North End,,Wednesday,Wed,Inverness Caledonian
Thistle,Inverness," & _
"and Hove Albion,H,Nottingham Forest,Notts Forest," & _
"West Bromwich Albion,W.Brom.Albion,Town,T," & _
"Rovers,,HotSpur,,Wanderers,,Athletic,,United,Utd, Alexandra,"

'Replace the team names from list above.
TeamArray = Split(TeamNames$, ",")
For A = 0 To UBound(TeamArray) Step 2
Set Rng = ActiveDocument.Range
Rng.Find.Execute findText:=TeamArray(A), _
replacewith:=TeamArray(A + 1), _
Replace:=wdReplaceAll
Next A

'This part sets columns.
With ActiveDocument.Range.ParagraphFormat.TabStops
.ClearAll
.Add Position:=CentimetersToPoints(1.9),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(2.54),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(3.17),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(3.81),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(4.44),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(5.08),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(5.71),
Alignment:=wdAlignTabRight
.Add Position:=CentimetersToPoints(6.35),
Alignment:=wdAlignTabRight
End With

Application.StatusBar = ""

End Sub