Run the following code in a new workbook. It will output to results to Sheet1 regardless of they are empty or not, so be careful if you have data there. You can change this part of code later as you like.
First of all you need to activate Microsoft HTML Object Library
and Microsoft Internet Controls
from Tools -> References
in VBA Editor. Then run the following code, sit back and relax until you see "All Done!" message:
Sub Company_links()
Dim i As Long
Dim aIE As InternetExplorer
Dim Rank As IHTMLElement, Company As IHTMLElement, Revenues As IHTMLElement
Set aIE = New InternetExplorer
With aIE
.navigate "http://fortune.com/fortune500/list/"
.Visible = True
End With
Do While (aIE.Busy Or aIE.ReadyState <> READYSTATE_COMPLETE)
DoEvents
Loop
For i = 1 To 50
On Error Resume Next
Set Rank = aIE.document.getElementsByClassName("column small-2 company-rank")(999)
If Rank Is Nothing Then
GoTo Skip
End If
Exit For
Skip:
SendKeys "{end}"
Application.Wait (Now() + TimeValue("00:00:005"))
Next i
With Sheet1
.Range("A1") = "RANK"
.Range("B1") = "COMPANY"
.Range("C1") = "REVENUE"
For i = 0 To 999
Set Rank = aIE.document.getElementsByClassName("column small-2 company-rank")(i)
Set Company = aIE.document.getElementsByClassName("column small-5 company-title")(i)
Set Revenues = aIE.document.getElementsByClassName("column small-5 company-revenue")(i)
.Range("A" & i + 2) = Rank.innerText
.Range("B" & i + 2) = Company.innerText
.Range("C" & i + 2) = Revenues.innerText
Next i
End With
SendKeys "%{F4}"
Set aIE = Nothing
Set Rank = Nothing
Set Company = Nothing
Set Revenues= Nothing
MsgBox "All Done!"
End Sub