[Tasos]

Στο συγκεκριμένο αρχείο κάνε κλικ σε ένα κελί και πάτησε ALT + F11
Στο παράθυρο που θα εμφανιστεί, αντικατέστησε όλο τον κώδικα που υπάρχει στη λειτουργική μονάδα "Module1" με τον παρακάτω:

Option Explicit

Sub GetWebData()
    Dim ie As InternetExplorer
    Dim oBody As HTMLBody
    Dim oTable As HTMLTable
    Dim TableCol As IHTMLElementCollection
    Dim strFilePath As String
    Dim fso As Scripting.FileSystemObject
    Dim oStream As Scripting.TextStream
    Dim strDate As String
    Dim ieResponseTimeout As Date
    Dim ProgRange As Range
    Dim TablehasData As Boolean
    Dim tblCount As Integer
    Set ProgRange = Range("progress")
    If IsDate(ShWebImport.Range("C1").Value) Then
        strDate = Format(ShWebImport.Range("C1").Value, "yyyy-MM-dd")
    Else
        ShWebImport.Activate
        Range("C1").Select
        ActiveWindow.ScrollRow = 1
        ProgRange = "Συμπλήρωσε ημερομηνία στο παραπάνω κελί"
        Exit Sub
    End If
    strFilePath = ThisWorkbook.Path & "\htm.html"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ie = CreateObject("InternetExplorer.Application")
    ie.RegisterAsBrowser = True
    '     ie.Visible = True
    ieResponseTimeout = Now + TimeSerial(0, 0, 20)
    On Error GoTo Exithere

    ProgRange = "Εισαγωγή δεδομένων από το web..."
    ie.Navigate2 "http://1x2.7m.hk/result_en.shtml?dt=" & strDate & "&cid=254"
     While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
        DoEvents
        If Now > ieResponseTimeout Then
            ProgRange = "Δεν είναι δυνατή η σύνδεση με την ιστοσελίδα."
            GoTo Exithere
        End If
    Wend
    If ie.document.URL Like "res://*" Then GoTo Exithere
    Set oBody = ie.document.body
    Set TableCol = oBody.getElementsByTagName("table")
    tblCount = TableCol.Length
    If tblCount Then
        ProgRange = "Επεξεργάζομαι δεδομένα..."
        For Each oTable In TableCol
            DoEvents
            If oTable.className = "t1" And oTable.Width = "598" Then
                ProgRange = "Δημιουργία τοπικού αρχείου *.html..."
                Set oStream = fso.CreateTextFile(strFilePath, True, True)
                oStream.write "<table>" & oTable.innerHTML & "</table>"
                oStream.Close
                TablehasData = True
                Exit For
            End If
        Next

    End If
Exithere:
    On Error Resume Next
    If Not ie Is Nothing Then
        ie.ExecWB OLECMDID_CLOSE, OLECMDEXECOPT_DONTPROMPTUSER, 0, 0
        Set ie = Nothing
        If Err <> 0 Then
            ProgRange = "Σφάλμα " & Err & " : " & Err.Description
            Exit Sub
        End If
    End If
    If TablehasData Then
        If ShWebImport.QueryTables.Count Then
            With ShWebImport.QueryTables(1)
                .Connection = "URL;file:///" & Replace(strFilePath, "\", "/")
                .Refresh BackgroundQuery:=False
                ProgRange = "Έγινε!"
            End With
        End If
    Else
        If tblCount Then
            ProgRange = "Δεν υπάρχουν δεδομένα για αυτή την ημερομηνία."
        Else
            ProgRange = "Δεν είναι δυνατη ησύνδεση με την ιστοσελίδα."
        End If
    End If
    If Err <> 0 Then
        ProgRange = "Error " & Err & " : " & Err.Description
    End If
End Sub

Αν δεν μπορείς να δεις τον αρχικό κώδικα, κάνε διπλό κλικ στη λειτουργική μονάδα "Module1" για να τον εμφανίσεις.

Καλή συνέχεια!

Τάσος