vba code to split payment into date range

[savo7us]

hi
I have a problem am trying to build a forecast for my company and am using a formulas to fix this issue.
but it make the size of the sheet over 20 MB with the date that I used more the 5000 row so when i run the sheet it take time to open and calculate this formulas .
as far as I knew The VBA code could fix the size and the time to run this sheet
I found this code but I could not modify it to my requirement

Sub MG19Jul02()
Dim Rng As Range, Dn As Range, oMax As Date, oMin As Date, n As Long
Dim Lst As Long, Dic As Object
With Sheets("Sheet1")
    Set Rng = .Range(.Range("E2"), .Range("E" & Rows.Count).End(xlUp))
End With
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For n = 0 To -1 Step -1
    For Each Dn In Rng
        If n = 0 Then
            oMax = Application.Max(oMax, Dn.Offset(, n).Value)
            oMin = oMax
        Else
            oMin = Application.Min(oMin, Dn.Offset(, n))
        End If
    Next Dn
Next n
With Sheets("Sheet2")
     .Range("A1:c1").Value = Array("Contract", "Product", oMin)
    .Range("C1").AutoFill Destination:=.Range("c1").Resize(, DateDiff("m", oMin, oMax) + 1), Type:=xlFillMonths
    Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
    .Range("C1").Resize(, Lst - 2).NumberFormat = "mmm-yy"
        For Each Dn In .Range("C1").Resize(, Lst - 2)
            Set Dic(Dn.Value) = Dn
        Next
        For Each Dn In Rng.Offset(, -1)
            If Dic.exists(Dn.Value) Then
                .Cells(Dn.Row, 1).Value = Dn.Offset(, -3).Value
                .Cells(Dn.Row, 2).Value = Dn.Offset(, -2).Value
                .Cells(Dn.Row, Dic(Dn.Value).Column).Resize(, Dn.Offset(, 2)).Value = Format(Dn.Offset(, -1).Value / Dn.Offset(, 2).Value, "0.000")
            End If
        Next Dn
End With
End Sub

my requirement is
I have 4 currency that am using in cell BO,BP,BQ and Br
the start dat of payment is in cell CD and end date is CE
the number of payment is in cell AH
what I need to do is
calculate the split the payment according to the number of months and if there is no payment in this month it recalculate and add this amount to the rest of the payment and if there is no payment for this row after the end date it be moved to next month as total
Note
started from cell CF3 I need it to automatically write the date as following ( mmm-yyyy currency ) and start from it finish to the next currency.
and it run automatically for the new entry without running the micro very time I add new entry



her is a link for this sheet
https://we.tl/t-lVBGdqx1KI

finally I appreciate your help and sorry for my way of typing cuz English is not my first language