Ответ = UCase(oHttp.responseText)
   Cells(ActiveCell.Row, "E") = Ответ
   Cells(ActiveCell.Row, "D") = Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TR>") - 18, 7)
   Курс = CCur(Mid(Ответ, InStr(InStr(1, Ответ, "EUR"), Ответ, "</TR>") - 18, 7))

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [A:A]) Is Nothing Or Target.Address(0, 0) = "A1" Then Exit Sub
    Cancel = True
    If Not IsDate(Target) Then Exit Sub
    Target.Offset(, 1) = CBR("EUR", Target)
    Target.Offset(, 2) = CBR("CZK", Target)
End Sub

' From   : http://www.excel-vba.ru/chto-umeet-excel/poluchit-kurs-valyut-ot-sberbanka/
'---------------------------------------------------------------------------------------
Function CBR(ByVal Cur, Optional ByVal CurDate) As Double
    Dim xmDoc As Object, date_req$
    Set xmDoc = CreateObject("msxml2.DOMDocument")
    date_req = "?date_req=" & Format(IIf(Not IsMissing(CurDate), CurDate, Date), "DD.MM.YYYY")
    xmDoc.async = 0: xmDoc.Load ("http://www.cbr.ru/scripts/XML_daily.asp" & date_req)
    With xmDoc.SelectSingleNode("*/Valute[CharCode='" & UCase(Cur) & "']")
        CBR = TextToNumber(.ChildNodes(4).Text) / Val(.ChildNodes(2).Text)
    End With
    Set xmDoc = Nothing
End Function

Function TextToNumber(ByVal txt)
  Dim s
  s = Mid(1 / 2, 2, 1)
  TextToNumber = CDbl(Replace(txt, IIf(s = ".", ",", "."), s))
End Function

Target.Offset(, 2) = CBR("CZK", Target) * 10