Import data from multiple websites

[leeksleeks]

Hi,

I am very interested in sports stats and am trying to import stats from multiple pages on the same website. For example in the below code it has game-93920 and the next page I would like to get the stats from is 93921. As each page has a unique code that is always 1 greater than the one before, is there anyway the 93920 can be replaced with an 'x'? If so I would ideally like each page to be pasted onto a new worksheet. Here is what I have done so far:

Sub importdata()


With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.itsrugby.co.uk/game-93920.html", Destination:=Range("$A$1"))
.Name = "game-93920"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9,12"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


End Sub

I have browsed other people having the same problem but cannot find anything that works for me. Any help would be greatly appreciated as this has stumped me for a long time.

Cheers

 

[Momentman]

Here's an idea, am assuming that the pages are game-93920 to game-93929, change as necessary.

Sub newwks()
Dim wks As Worksheet
For I = 93920 To 93929
        Set wks = Worksheets.Add
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.itsrugby.co.uk/game-93920.html", Destination:=wks.Range("$A$1"))
        .Name = "game-" & I
        
        'the rest of your code goes here
Next I
End Sub

 

[leeksleeks]

Wow that is amazing. Works perfectly. Thank you very much Momentman!!!

 

[leeksleeks]

Actually looking at this closer it actually seems to be just importing the same webpage everytime and not changing from 93920 to 93921. Any idea why this would be?

 

[leeksleeks]

Actually looking at this closer it actually seems to be just importing the same webpage everytime and not changing from 93920 to 93921. Any idea why this would be?

Sub newwks2()
Dim wks As Worksheet
For I = 93920 To 93925
Set wks = Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.itsrugby.co.uk/game-93920.html", Destination:=wks.Range("$A$1"))
.Name = "game-" & I
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next I

End Sub


</pre>

 

[Momentman]

This should fix it

Sub newwks2()
 Dim wks As Worksheet
     For i = 93920 To 93925
        Set wks = Worksheets.Add
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.itsrugby.co.uk/game-" & i & ".html", Destination:=wks.Range("$A$1"))
        .Name = "game-" & i
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
     End With
    
     Next i
 End Sub

 

[leeksleeks]

That has indeed worked. Thank you very much!

 

[Momentman]

I guess you know the line that fixed it. I changed the URL address toincorporate the value of I i.e this line

With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.itsrugby.co.uk/game-" & i & ".html", Destination:=wks.Range("$A$1"))