Cómo puedo optimizar una macro demasiado lenta?

Agradezco vuestra ayuda ya que llevo horas quebrandome la cabeza y no logro solucionar. Resulta que tengo una archivo que simula un pequeño sistema de control de pago a proveedores. Hay una parte que recoge informacion de pagos, fechas, calcula saldos e indica en que estado se encuentra. Esto ultimo mediante un Select Case que toma el saldo como argumento y creo que ahí es donde se genera la lentitud de mi macro. Incorporé la desactivación de ScreenUpdate, y modo de calculo manual y de 7 minutos que tomaba, bajó a 3 pero sigue siendo muy lenta

Dejo el código para que me puedan echar una manito. Llevo poco tiempo trabajando con VBA y hay trucos y detalles que aun no manejo bien.

Sub Pagos()
'pagos, fecha ultimo pago, saldo, estado
Dim ultimafila As Long
Dim cuota As Variant
Dim montopagado As Variant
Dim fecha As Variant
Dim saldo As Variant

Application.ScreenUpdating = False
'buscadores rut y nro docto
Sheets("Base_Pagos").Select
Range("F4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'obtener posicion ultima fila con datos
Sheets("Compras_Saldos").Select
ultimafila = Cells(Rows.Count, "C").End(xlUp).Row
'recoger montos pagados
For i = 5 To ultimafila
'=-SUMAR.SI.CONJUNTO(Base_Pagos!I:I;Base_Pagos!C:C;D69;Base_Pagos!D:D;E69;Base_Pagos!F:F;L69)
montopagado = -Application.WorksheetFunction.SumIfs(Range("Base_Pagos!I:I"), Range("Base_Pagos!C:C"), Cells(i, "D"), Range("Base_Pagos!D:D"), Cells(i, "E"), Range("Base_Pagos!F:F"), Cells(i, "L"))
'pegar fecha ultimo pago y fecha flujo
'=+CONTAR.SI.CONJUNTO(Base_Pagos!C:C;Compras_Saldos!D69;Base_Pagos!D:D;Compras_Saldos!E69;Base_Pagos!F:F;Compras_Saldos!L69) #cuota
'=+SUMAR.SI.CONJUNTO(Base_Pagos!H:H;Base_Pagos!C:C;D69;Base_Pagos!D:D;E69;Base_Pagos!F:F;L69;Base_Pagos!G:G;pagos) fecha
cuota = Application.WorksheetFunction.CountIfs(Range("Base_Pagos!C:C"), Cells(i, "D"), Range("Base_Pagos!D:D"), Cells(i, "E"), Range("Base_Pagos!F:F"), Cells(i, "L"))
fecha = Application.WorksheetFunction.SumIfs(Range("Base_Pagos!H:H"), Range("Base_Pagos!C:C"), Cells(i, "D"), Range("Base_Pagos!D:D"), Cells(i, "E"), Range("Base_Pagos!F:F"), Cells(i, "L"), Range("Base_Pagos!g:g"), cuota)
If montopagado = 0 Then
Cells(i, "O").value = ""
Else
Cells(i, "O").value = montopagado
End If
If fecha = 0 Then
Cells(i, "R").value = ""
Else
Cells(i, "R").value = fecha
End If
'codigo fecha flujo, pendiente
'suma saldos
saldo = Cells(i, "M") + Cells(i, "N") + Cells(i, "O")
Cells(i, "P").value = saldo
Select Case saldo
Case 0
With Cells(i, "Q")
.value = "Pagado"
.Font.Bold = False
.Interior.Pattern = xlNone
End With
Case Is < 0
With Cells(i, "Q")
.value = "Saldo a favor"
.Font.Bold = False
.Interior.Pattern = xlNone
End With
Case Is > 0
If Cells(i, "H").value < Date Then
With Cells(i, "Q")
.value = "Vencido"
.Font.Bold = True
.Interior.Color = RGB(250, 187, 189)
End With
Else
With Cells(i, "Q")
.value = "Por pagar"
.Font.Bold = False
.Interior.Pattern = xlNone
End With
End If
Case Else
If Cells(i, "H").value < Date Then
With Cells(i, "Q")
.value = "Vencido"
.Font.Bold = True
.Interior.Color = RGB(250, 187, 189)
End With
Else
With Cells(i, "Q")
.value = "Por pagar"
.Font.Bold = False
.Interior.Pattern = xlNone
End With
End If
End Select
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub