Import data from multiple pages of a website into a single Excel sheet

[trainheavy]

Hi,

I'm trying to figure out a way to query data for batters vs left hand and batters vs right hand. The problem is, it only lists 40 per page and I don't know how to query all the pages onto a single page in excel. This is what I'm referring to: http://espn.go.com/mlb/stats/batting/_/ ... fied/false. Any help would be greatly appreciated.

This is the query I came up with - it cycles through but no data actually appears:

Code: Select all

Sub BatterVsLeftHand()
Dim nextRow As Integer, n As Integer
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
For n = 1 To 441 Step 40
Application.StatusBar = "Processing Page " & n
nextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://espn.go.com/mlb/stats/batting/_/split/31/count/" & n & "/qualified/false", _
Destination:=Range("A" & nextRow))
.Name = "mlb/stats/batting/_/split/31/count/440/qualified/false"
.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 = "22"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ThisWorkbook.Save
Next n
Application.StatusBar = False
End Sub

[NoSparks]

This works for me.
All I did was use the macro recorder while manually getting the first page and insert your variables into the recorded macro to look after the whole thing.

Code: Select all

Option Explicit

Sub Macro1()
'
' Macro1 Macro
'
    Dim nextRow As Integer
    Dim n As Integer
   
Application.ScreenUpdating = False
Application.DisplayStatusBar = True

For n = 1 To 441 Step 40
    Application.StatusBar = "Processing Page " & n
    nextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
   
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://espn.go.com/mlb/stats/batting/_/split/31/count/1/qualified/false", _
        Destination:=Range("$A$" & nextRow))
        .Name = "false"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    'ThisWorkbook.Save
Next n
Application.StatusBar = False
End Sub


[trainheavy]

It does pull in the data, but strangely some pages pull in and paste in other columns. For example if you replace /1/ with /41/ it doesn't pull the data into column A. But if I use /81/ it will. I can't quite figure out why it varies all over the place.

This works for me.
All I did was use the macro recorder while manually getting the first page and insert your variables into the recorded macro to look after the whole thing.

Code: Select all

Option Explicit

Sub Macro1()
'
' Macro1 Macro
'
    Dim nextRow As Integer
    Dim n As Integer
   
Application.ScreenUpdating = False
Application.DisplayStatusBar = True

For n = 1 To 441 Step 40
    Application.StatusBar = "Processing Page " & n
    nextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
   
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://espn.go.com/mlb/stats/batting/_/split/31/count/1/qualified/false", _
        Destination:=Range("$A$" & nextRow))
        .Name = "false"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    'ThisWorkbook.Save
Next n
Application.StatusBar = False
End Sub


[NoSparks]

Change this line

Code: Select all

nextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

to use column "B" instead of column "A".

[trainheavy]

That did the trick - thanks!

Change this line

Code: Select all

nextRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

to use column "B" instead of column "A".

[pecoflyer]

@ trainheavy

Please don't quote whole posts -- it's just clutter. If you are responding to a post out of sequence, limit quoted content to a few relevant lines that makes clear to whom and what you are responding.