Multiple Table download from the internet to Excel Yahoo Finance Japan


New Member
Dec 19, 2017
Dear All,

I hope you can help me I am trying to download historical share data for share 8088 from yahoo Japan.

The first page of the table I need is in the following location: -

I then want to download all the share data the above is 1~20件/8554件中 as you will see in the top left corner.

The final page is page 428 at the following URL....

I am looking to get all these pages from 1-428 into excel on a single sheet so I can complete this analysis.



Well-known Member
May 24, 2005
The following code will do what you asked for, but you will have some cleanup to do. I set it to extract pages 1 to 428. I understand that some sites prevent more than a certain number of downloads in a set short time (e.g., 50 queries per hour). If this is the case you will have to changes this line:

For lPage = 1 To 428 'Manually set page range

to get the pages you want.

That page has 3 tables and your data is in table 2. If you want all of the tables comment out the If tabno = 2 Then line and its corresponding End If line

Option Explicit

Sub ExtractDataFromTables()
    'Modification of
    Dim ie As Object
    Dim myTextField
    Dim doc     'Variant/Object/HTMLDocument
    Dim lPage As Long
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        For lPage = 1 To 428   'Manually set page range
            .Visible = True
            '.navigate ""
            .navigate "" & lPage
            Do Until .readyState = 4: DoEvents: Loop
    '        Set myTextField = .Document.all.Item("series_id")
    '        myTextField.Value = "ECU11121I"
    '        ie.Document.Forms(0).submit
    '        Do Until .ReadyState = 4: DoEvents: Loop
    '        Do While .Busy: DoEvents: Loop
            Set doc = ie.document
            GetAllTables doc
    End With
    Set doc = Nothing
    Set ie = Nothing
End Sub

Sub GetAllTables(d)

    Dim e   'Variant/Object/HTMLTable
    Dim t   'Variant/Object/HTMLTable
    Dim tabno As Long
    Dim nextrow As Long
    Dim Rng As Range
    Dim R   'Variant/Object/HTMLTableRow
    Dim c   'Variant/Object/HTMLTableCell
    Dim i As Long
    For Each e In d.all
        If e.nodeName = "TABLE" Then
            Set t = e
            tabno = tabno + 1
            If tabno = 2 Then
                nextrow = Cells(Rows.Count, 2).End(xlUp).Row + 1
                Set Rng = Range("B" & nextrow)
                Rng.Offset(, -1) = "Table " & tabno
                For Each R In t.Rows
                    For Each c In R.Cells
                        Rng.Value = c.innerText
                        Set Rng = Rng.Offset(, 1)
                        i = i + 1
                    Next c
                    nextrow = nextrow + 1
                    Set Rng = Rng.Offset(1, -i)
                    i = 0
                Next R
            End If
        End If
    Next e
    Set Rng = Nothing
    Set t = Nothing
End Sub
Last edited:

Forum statistics

Latest member

Some videos you may like

This Week's Hot Topics