Sub ЗагрузкаТекстаВебСтраницы()
    Dim F$, W$
    Dim IE As Object, addr$, txt$

    Set IE = CreateObject("InternetExplorer.Application")    ' загружаем браузер Internet Explorer
    ' On Error Resume Next  ' <-- "глотать" ошибки вредно для здоровья!

 ' ... получение текста Web-траницы в переменную txt

    F = "строка1"
    W = "строка10"

Dim k&, z&, arr

    k = InStr( 1 , txt, F, vbTextCompare)                     ' поиск первой фразы в тексте страницы
    If k >  0  Then s = Mid$(txt, k + Len(F)) Else s = txt    ' нашли - "укоротили" текст, не нашли - взяли текст полностью

    k = InStr( 1 , s, W, vbTextCompare)                       ' поиск второй фразы в "остатке" текста
    If k >  0  Then s = Left$(s, k -  1 )                       ' нашли - "укоротили" "остаток", не нашли - взяли "остаток" полностью

    arr = Split(s, vbNewLine)                               ' создали из строки массив, разделитель - системный "символ новой строки"
                                                            ' если на Web-странице изпользовался другой  "символ новой строки"
                                                            ' нас ждет сокрушительное фиаско :'(

    With Worksheets("parse")                                ' Запись массива на лист
        .UsedRange.ClearContents
        k =  0 : z =  1 
        For k =  0  To UBound(arr)
            s = Trim(arr(k))                                ' строки, состоящие только из пробелов, на лист не пишем
            If s > "" Then
                .Cells(z,  1 ) = s: z = z +  1 : End If   
        Next k
    End With

    Erase arr                                               ' освобождение памяти, выделенной под массив

End Sub

' переносит данные (без форматирования) из таблицы HTML - на лист Excel
' (!) в HTML таблицы с объединнёными ячейками и вложенными таблицами обрабатывать не умеет
' параметры:
' [in] aCell - ссылка на ячейку листа Excel с которой начнём выгрузку
' [in] sTBL - таблица в HTML
'               начинается с тега <TABLE ...> (не обязательно)
'               заканчивается тегом </TABLE> (не обязательно)
' [in Opt] iRows - сколько строк переносить (если не задан переносим все)
' [in Opt] iCols - сколько столбцов переносить (если не задан переносим все)
' возвращаемое значение:
'   0  - "парсинг" прошёл удачно
'   2  - не найден открывающий тэг строки
'   4  - не найден закрывающий тэг строки
'   8  - не найден открывающий тэг столбца
'   16 - не найден закрывающий тэг столбца
'   32 - ошибка при выгрузке данных на лист
Function HtmlTableToSheet%(aCell As Range, sTBL$, Optional iRows%, Optional iCols%)
Dim s$, sRow$, k%, k2%, z%, z2%
Dim iRCopied%, iCCopied%
Dim iExitDo%
    
    s = Replace(sTBL, vbNewLine, "")
    s = UCase(s)
    
    k = InStr( 1 , s, "<TR")      ' открывающий тэг строки в HTML таблице
    If k =  0  Then ' не нашли открывающего тэга строки - вышли из функции с кодом 2
        HtmlTableToSheet =  2 : Exit Function
    End If
    
    ' цикл по строкам HTML таблицы
    Do While k >  0  And (iRows =  0  Or iRCopied < iRows)
        k = InStr(k +  3 , s, ">")        ' окончание открываюшего тэга строки
        k2 = InStr(k +  1 , s, "</TR>")   ' закрывющий тэг строки
        
        If k2 =  0  Then ' не нашли закрывающего тэга строки - вышли из цикла (функции) с кодом 4
            HtmlTableToSheet =  4 : Exit Do
        End If
        
        sRow = Mid(s, k +  1 , k2 - k -  1 )  ' строка HTML таблицы без открывающего и закрывающего тэгов
        z = InStr( 1 , sRow, "<TD")   ' открывающий тэг столбца в HTML таблице
        If z =  0  Then ' не нашли открывающего тэга столбца - вышли из цикла (функции) с кодом 8
            HtmlTableToSheet =  8 : Exit Do
        End If
        
        iCCopied =  0  ' счетчик скопированных столбцов в текущей строке
        
        ' цикл по столбцам текущей строки HTML таблицы
        Do While z >  0  And (iCols =  0  Or iCCopied < iCols)
            z = InStr(z +  3 , sRow, ">")        ' окончание открываюшего тэга столбца
            z2 = InStr(z +  1 , sRow, "</TD>")   ' закрывющий тэг столбца
            
            If z2 =  0  Then  ' не нашли закрывающего тэга столбца -
                            ' установили флаг выхода из цикла равным 16 (для внешнего цикла),
                            ' вышли из цикла
                iExitDo =  16 : Exit Do
            End If
            
            ' перенос значения ячейки HTML таблицы на лист Excel
            On Error Resume Next
            aCell.Offset(iRCopied, iCCopied).Value = Mid(sRow, z +  1 , z2 - z -  1 )
            If Err.Number <>  0  Then
            ' не удалось выгрузить очередное значение - сбросили ошибку,
            ' установили флаг выхода из цикла равным 32 (для внешнего цикла), вышли из цикла
                Err.Clear: iExitDo =  32 : Exit Do
            Else
                iCCopied = iCCopied +  1 
                z = InStr(z2 +  5 , sRow, "<TD")
                On Error GoTo  0 
            End If
        Loop    ' цикл по стоблцам
        
        If iExitDo Then     ' если флаг поднят (не найден закрывающий тэг столбца или ошибка при выгрузке на лист)
                            ' вышли из цикла (функции) с кодом iExitDo
            HtmlTableToSheet = iExitDo: Exit Do
        End If
        
        iRCopied = iRCopied +  1 
        k = InStr(k2 +  5 , s, "<TR")
    Loop    ' цикл по строкам
' ЗЫ: "по-взрослому" следовало бы прикрутить сюда регулярные выражения...
End Function

Sub proba_HtmlTableToSheet()
Dim s$, i%
' Ваша строка
    s = _
"</TH></TR>" & vbCrLf & _
"<TR>" & vbCrLf & _
"<TD>5</TD>" & vbCrLf & _
"<TD>5</TD>" & vbCrLf & _
"<TD>24 000</TD>" & vbCrLf & _
"<TD>27 000</TD>"
    
    s = s & "</TR>" ' <--наличие закрывающего тэга строки обязательно
    
    i = HtmlTableToSheet(ThisWorkbook.Worksheets( 1 ).Cells( 2 ,  2 ), s)
    
End Sub