Public Sub Price_Parser()
Dim LinkCell As Range
Dim sURI As String
Dim oHttp As Object
Dim htmlcode, outstr As String
   On Error Resume Next
   Set oHttp = CreateObject("MSXML2.XMLHTTP"  
   If Err.Number <> 0 Then
    Set oHttp = CreateObject("MSXML.XMLHTTPRequest"  
   End If
   On Error GoTo 0
   If oHttp Is Nothing Then
    Exit Sub
   End If
   For Each LinkCell In Selection
   sURI = LinkCell.Hyperlinks(1).Address
   oHttp.Open "GET", sURI, False
   oHttp.Send
   'получаем HTML страницы
   htmlcode = oHttp.responseText
   a = Len(htmlcode)
   b = InStr(1, htmlcode, LinkCell.Value, vbTextCompare)
   htmlcode = Right(htmlcode, a - b + 1)
   htmlcode = Mid(htmlcode, InStr(1, htmlcode, "floatr"   + 8, 10)
   LinkCell.Offset(0, 1).NumberFormat = "0.00"
   LinkCell.Offset(0, 1).Value = htmlcode
   Next LinkCell
Set oHttp = Nothing
MsgBox ("ГОТОВО"  
End Sub