Public Function GetBR(ByVal CurrencyName As String, Optional ByVal d As Date) As Double
     Dim sURL As String
     If d = 0 Then d = Now()
     sURL = "https://www.nbrb.by/services/xmlexrates.aspx?ondate=" & Format(d, "mm/dd/yyyy")
     Dim oXMLHTTP
     On Error Resume Next
     Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
     With oXMLHTTP
        .Open "GET", sURL, False
        .send
        k = Split(Split(.responseText, CurrencyName & "</Name>")(1), "</Rate>")(0)
        GetBR = Val(Right(k, Len(k) - InStr(1, k, ">")))
     End With
     Set oXMLHTTP = Nothing
End Function

Sub DeleteEmptySpace()
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    LastClm = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
    Application.ScreenUpdating = False
    For R = LastRow To 1 Step -1
        If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
    Next R
    For N = LastClm To 1 Step -1
        If Application.CountA(Columns(N)) = 0 Then Columns(N).Delete
    Next N
End Sub

или так

Sub DeleteEmptyRows()
Dim i&, LastRow&, LastCol&
With ActiveSheet.UsedRange
    LastRow = .Row - 1 + .Rows.Count
    LastCol = .Column - 1 + .Columns.Count
End With
Application.ScreenUpdating = False
For R = LastRow To 1 Step -1
    If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
Next R
For N = LastCol To 1 Step -1
    If Application.CountA(Columns(N)) = 0 Then Columns(N).Delete
Next N
End Sub
 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rInt As Range, rCel As Range
Set rInt = Intersect(Target, Range("g10:h" & Rows.Count))
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not rInt Is Nothing Then
            If IsEmpty(rInt) Then
                 Range("p" & cell.Row).Value = Empty
            Else
                With Range("p" & cell.Row)
                    .Value = Now
                    .NumberFormat = "dd.mm.yyyy hh:mm:ss"
                    .EntireColumn.AutoFit
                End With
            End If
       End If
    Next cell
End Sub

Sub Get_Last_Cell()
r = Range("A5:A" & Rows.Count).End(3).Row
End Sub

Function addListsToComboBox(myCombobox As ComboBox) As Integer
Dim wb As Workbook
Dim sh As Worksheet
Dim shActName As String
Set wb = ActiveWorkbook

shActName = ActiveSheet.name

f = wb.name
returnValue = 0
VisibleListCount = 0

For j = 1 To wb.Sheets.Count
Set sh = wb.Sheets(j)
If sh.Visible = True Then
VisibleListCount = VisibleListCount + 1
End If
Next

For j = 1 To VisibleListCount
Set sh = wb.Sheets(j)
If sh.Visible = True Then
myCombobox.AddItem (sh.name)
If sh.name = shActName Then
returnValue = j - 1
End If
End If
Next

addListsToComboBox = returnValue
End Function