Dim XMLpage As New MSXML2.XMLHTTP60
Dim HTMLdoc As New MSHTML.htmlDocument
Dim Elements As IHTMLElementCollection
Dim Headers As IHTMLElementCollection
Dim Table As IHTMLElementCollection
Dim Element As Object, row_data As Object
Dim i As Integer, j As Integer
ThisWorkbook.Sheets("Sheet1").Cells.Clear
ThisWorkbook.Sheets("Sheet1").Cells(1, 1) = "Calls"
ThisWorkbook.Sheets("Sheet1").Cells(1, 7) = "Puts"
my_url = "https://finance.yahoo.com/quote/QQQ/options?c=QQQ&date=1642723200&straddle=true"
XMLpage.Open "GET", my_url, False
XMLpage.send
HTMLdoc.body.innerHTML = XMLpage.responseText
Set Elements = HTMLdoc.getElementsByTagName("table")
'Get option table header from first object
Set Headers = Elements(0).getElementsByTagName("thead")(0).getElementsByTagName("th")
i = 1
For Each Element In Headers
ThisWorkbook.Sheets("Sheet1").Cells(2, i) = Element.getElementsByTagName("span")(0).innerText
If Element.innerText <> "" Then
i = i + 1
End If
Next
'Get option table data from second object
Set Table = Elements(0).getElementsByTagName("tbody")(0).getElementsByTagName("tr")
i = 3
For Each Element In Table
Set row_data = Element.getElementsByTagName("td")
j = 1
For Each table_data In row_data
ThisWorkbook.Sheets("Sheet1").Cells(i, j) = table_data.innerText
j = j + 1
Next
i = i + 1
Next