Ajuste en Código para saldos

Acudo a ustedes en busca de un empujón con un código que he inventado, pero no me termina de hacer lo que deseo.

En la imagen se observa el formato. Deseo introducir 1.670.000,00 en la celda señalada y que automáticamente haga la resta hasta saldar el último monto.

Pero de introducir un monto menor lo ajuste a los meses que se puedan reducir y el resto lo abone al monto siguiente.

En caso de que sea mayor debe abonarlo a la celda siguiente dejando un saldo a favor.

El código es este:

Sub Resta()
Dim i As Integer
Dim Res2 As String
Dim Res1 As String
If Range("E:E").End(xlDown).Offset(0, -1).Value < Range("E:E").End(xlDown).Value Then
Res2 = Range("E:E").End(xlDown).Value - Range("E:E").End(xlDown).Offset(0, -1).Value
Range("E:E").End(xlDown).Offset(1, 0).Value = Res2
Range("E:E").End(xlDown).Offset(-1, 0).Value = Range("E:E").End(xlDown).Offset(-1, -1).Value
For i = 1 To 3
Call Resta
Next i
End If
If Range("E:E").End(xlDown).Offset(0, -1).Value = Range("E:E").End(xlDown).Value Then
Exit Sub
End If
Res1 = ActiveSheet.Range("E:E").End(xlDown).Offset(0, -1).Value - ActiveSheet.Range("E:E").End(xlDown).Value
ActiveSheet.Range("E:E").End(xlDown).Offset(1, -1).Select
Range("E:E").End(xlDown).Offset(1, -1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E:E").End(xlDown).Offset(1, -4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E:E").End(xlDown).Offset(1, -4).Value = Range("E:E").End(xlDown).Offset(0, -4).Value
ActiveSheet.Range("E:E").End(xlDown).Offset(1, -1).Value = Res1
ActiveSheet.Range("F4").AutoFill Destination:=Range("F4:F57"), Type:=xlFillDefault
ActiveSheet.Range("L4").Value = ActiveSheet.Range("E:E").End(xlDown).Value
End Sub

Añade tu respuesta

Haz clic para o