Code:
Sub xScoresTable_Import()
Dim ie As InternetExplorer
Dim i As Range
Dim x As Range
Dim y As Range
Dim BinString As String
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'Go to this Web Page!
ie.navigate "http://www.xscores.com/LiveSco...amp;newState=promptSoccerTable "
'Check for good connection to web page loop!
Do Until ie.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Do Until ie.Busy = False
DoEvents
Loop
' type STOP in cell A1 to stop the macro/refresh
1
If Range("A1").Value = "STOP" Then Exit Sub
Cells.Select
Selection.Clear '.Delete
Range("A1").Select
Dim oResultPage As HTMLDocument
Dim AllTables As IHTMLElementCollection
Dim xTable As HTMLTable
Dim TblRow As HTMLTableRow
Dim myWkbk As Worksheet
'copy "data" table
Set oResultPage = ie.Document
Set AllTables = oResultPage.getElementsByTagName("table")
Set xTable = AllTables.Item(2)
Set myWkbk = ActiveWorkbook.Sheets("Sheet2")
For Each TblRow In xTable.Rows
r = r + 1
For Each tblCell In TblRow.Cells
c = c + 1
myWkbk.Cells(r, c) = tblCell.innerText
Next tblCell
c = 0
Next TblRow
r = 0
' refresh values every 15 mins
s = Now
Do Until Now >= s + TimeValue("00:15:00")
DoEvents
Loop
GoTo 1
End Sub
Sub xScoresTable_Import()
Dim ie As InternetExplorer
Dim i As Range
Dim x As Range
Dim y As Range
Dim BinString As String
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'Go to this Web Page!
ie.navigate "http://www.xscores.com/LiveSco...amp;newState=promptSoccerTable "
'Check for good connection to web page loop!
Do Until ie.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Do Until ie.Busy = False
DoEvents
Loop
' type STOP in cell A1 to stop the macro/refresh
1
If Range("A1").Value = "STOP" Then Exit Sub
Cells.Select
Selection.Clear '.Delete
Range("A1").Select
Dim oResultPage As HTMLDocument
Dim AllTables As IHTMLElementCollection
Dim xTable As HTMLTable
Dim TblRow As HTMLTableRow
Dim myWkbk As Worksheet
'copy "data" table
Set oResultPage = ie.Document
Set AllTables = oResultPage.getElementsByTagName("table")
Set xTable = AllTables.Item(2)
Set myWkbk = ActiveWorkbook.Sheets("Sheet2")
For Each TblRow In xTable.Rows
r = r + 1
For Each tblCell In TblRow.Cells
c = c + 1
myWkbk.Cells(r, c) = tblCell.innerText
Next tblCell
c = 0
Next TblRow
r = 0
' refresh values every 15 mins
s = Now
Do Until Now >= s + TimeValue("00:15:00")
DoEvents
Loop
GoTo 1
End Sub
Macro sam preuzeo sa ove lokacije: http://www.mrexcel.com/forum/e...7-copy-webdata-into-excel.html