Cells(1, 1) = IE.Document.getElementsByClassName("res-text")(0).innerText

    Dim a_pages As Variant, p As Variant, q As Variant
    Dim url As String
    a_pages = Sheets("Начало").[m7:m11]
    url = Sheets("Начало").Cells(5, 13)
    For Each p In a_pages
        Sheets("" & p & "").Activate
        Sheets("" & p & "").Cells.Clear
        For Each q In Sheets("" & p & "").QueryTables
            q.Delete
        Next
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;" & url & p, Destination:=[a1])
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .Refresh BackgroundQuery:=False
        End With
    Next

    Dim m_url As String, d_url As String, file_name As String, temp_path As String
    Dim body() As Byte
    m_url = "https://circabc.europa.eu/ui/group/b21bad6d-4ffc-4aff-8ae6-fe5f35a7480a/library/0874d9bc-2772-4c8c-8b79-665279a04d01/details"
    d_url = "https://circabc.europa.eu/rest/download/" & Split(Split(m_url, "library/")(1), "/")(0)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", d_url, 0
        .Send
        body = .responseBody
        file_name = Split(.getResponseHeader("Content-Disposition"), "filename=")(1)
    End With
    temp_path = Environ("Temp") & "\" & file_name
    With CreateObject("ADODB.Stream")
        .Mode = 3
        .Type = 1
        .Open
        .Write body
        .SaveToFile temp_path, 2
    End With
    CreateObject("Shell.Application").Open (temp_path)

Sub St()
    Dim URL$, txt As String, clid As String, lang As String, vspid As String, data As String, id As String
    clid = "594"
    lng = "en"
    vspid = "1"
    data = "#2_1,3_800,22_7,5_1493800,9_match,8_1181210054,178_53405,7_53403"
    URL = "https://vfl3.betradar.com/s4/?clientid=" & clid & "&language=" & lng & "&vsportid=" & vspid & data
    txt = DownloadText(URL)
    id = Split(Split(txt, "id"":""")(1), """,")(0)
    URL = "https://vfl3.betradar.com/s4/gismo.php?&id=" & id & "&language=" & lng & "&clientid=" & clid & "&vsportid=" & vspid & "&state=" & data
    txt = DownloadText(URL)
    Cells(1, 1) = txt
End Sub
Private Function DownloadText(ByVal URL As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", Replace(URL$, "\", "/"), "False"
        .setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
        .setRequestHeader "Content-Type", "text/html; charset=utf-8"
        .send
        If .statustext = "OK" Then DownloadText = .responseText
    End With
End Function

Sub Upd()

MsgBox("Start!")

Sub Upd()
    ActiveWorkbook.RefreshAll
    Application.OnTime Now + TimeValue("00:00:07"), "Upd"
End Sub

XMLHTTP.SetRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"

Function postj(ByVal URL$, ByVal json As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", Replace(URL$, "\", "/"), "False"
        .setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
        .setRequestHeader "Content-Type", "application/json; charset=utf-8"
        .setRequestHeader "Accept-Language", "ru-RU"
        .send (json)
        If .statustext = "OK" Then postj = .responseText
    End With
End Function

    With CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\test.html", 1, True)
        txt = .ReadAll: .Close
    End With
    txt = Replace(Replace(txt, Chr(10), ""), Chr(13), "")
    txt = Split(Split(txt, "Features:</strong>")(1), "/p>")(0)
    With CreateObject("VBScript.RegExp")
        .Global = True: .IgnoreCase = True: .Pattern = ">(.+?)<"
        If .test(txt) Then
            Set Matches = .Execute(txt)
            If Matches.Count > 0 Then
                For m = 0 To Matches.Count - 1
                    Cells(m + 1, 1) = Matches(m).SubMatches(0)
                Next
            End If
        End If
    End With

    Dim arr() As Variant
    Dim txt As String
    arr = Application.Transpose(Range("a1:a293"))
    txt = Join(arr)
    Erase arr
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\d){11}"
        If .test(txt) Then
            Set Matches = .Execute(txt)
            If Matches.Count > 1 Then
                ReDim arr(Matches.Count - 1)
                For i = 0 To Matches.Count - 1
                    arr(i) = Matches(i)
                Next
                ActiveSheet.Range("B1").Resize(Matches.Count, 1) = Application.Transpose(arr)
            End If
        End If
    End With

    Dim i As Long
    Dim t As Double
    'Dim sorted As Variant
    Randomize
    With CreateObject("System.Collections.ArrayList")
        For i = 0 To 1999999
          .Add Format$(Int(Rnd * 2000000), "0000000")
        Next
        t = Timer
        .Sort
        'sorted = .ToArray
        Debug.Print Timer - t
    End With