Private Sub CommandButton2_Click()
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.yandex.ru", _
        Destination:=Range("B37"))
        .Name = "www.yandex.ru_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod =  0 
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Columns("B:C").Select
    Selection.ColumnWidth =  16 
    Range("C38").Select
    Selection.NumberFormat = "[$$-409]#,##0.0000"
    Range("C39").Select
    Selection.NumberFormat = "[$€-2] #,##0.0000"
End Sub

Private Sub CommandButton1_Click()
    Dim sURI As String
      Dim oHttp As Object
       Dim htmlcode, outstr As String
       Dim inpdate As Date
       Dim d, m, y As Integer
  
        inpdate = CDate(InputBox("Введите дату в формате ДД.ММ.ГГГГ", _
           "Курс доллара", Date))
     d = Format(inpdate, "dd")
    m = Format(inpdate, "mm")
     y = Format(inpdate, "yyyy")
      sURI = "http://cbr.ru/currency_base/daily.aspx?C_month=" & m & "&C_year=" _
                    & y & "&date_req=" & d & "%2F" & m & "%2F" & y
       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
      oHttp.Open "GET", sURI, False
       oHttp.Send
      htmlcode = oHttp.responseText
       outstr = Mid(htmlcode, InStr( 1 , htmlcode, "USD") +  87 ,  7 )
      Set oHttp = Nothing
      outstr = Replace(outstr, ",", ".")
      ActiveCell.Value = outstr
End Sub

Private Sub CommandButton1_Click()
    Dim sURI As String
      Dim oHttp As Object
       Dim htmlcode, outstr As String
       Dim inpdate As Date
       Dim d, m, y As Integer
  
        inpdate = CDate(InputBox("Ââåäèòå äàòó â ôîðìàòå ÄÄ.ÌÌ.ÃÃÃÃ", _
           "Êóðñ äîëëàðà", Date))
     d = Format(inpdate, "dd")
    m = Format(inpdate, "mm")
     y = Format(inpdate, "yyyy")
sURI = "http://WWW.cbr.ru/currency_base/daily.aspX?C_month=" & m & "&C_year=" & y & "&date_req=" & d & "%2F" & m & "%2F" & y
       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
      oHttp.Open "GET", sURI, False
       oHttp.Send
      htmlcode = oHttp.responseText
       outstr = Mid(htmlcode, InStr( 1 , htmlcode, "USD") +  87 ,  7 )
      Set oHttp = Nothing
      outstr = Replace(outstr, ",", ".")
      Range("a1") = outstr
End Sub

Private Sub CommandButton2_Click()
    Dim sURI As String
      Dim oHttp As Object
       Dim htmlcode, outstr As String
       Dim inpdate As Date
       Dim d, m, y As Integer
  
        inpdate = CDate(InputBox("Ââåäèòå äàòó â ôîðìàòå ÄÄ.ÌÌ.ÃÃÃÃ", _
           "Êóðñ äîëëàðà", Date))
     d = Format(inpdate, "dd")
    m = Format(inpdate, "mm")
     y = Format(inpdate, "yyyy")
sURI = "http://WWW.cbr.ru/currency_base/daily.aspX?C_month=" & m & "&C_year=" & y & "&date_req=" & d & "%2F" & m & "%2F" & y
       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
      oHttp.Open "GET", sURI, False
       oHttp.Send
      htmlcode = oHttp.responseText
       outstr = Mid(htmlcode, InStr( 1 , htmlcode, "EUR") +  81 ,  7 )
      Set oHttp = Nothing
      outstr = Replace(outstr, ",", ".")
      Range("b1") = outstr
End Sub