mevcut kodlara ekleme yapmak

[muhsar]

Private Sub CommandButton1_Click()
Dim sf As Worksheet, sh As Worksheet
Set sf = Sheets("Aidat")
son = sf.Range("A" & Rows.Count).End(3).Row
a = sf.Range("B2:D" & son).Value

If son < 2 Then MsgBox "Yetersiz tablo.", vbCritical: Exit Sub
    Set sh = Sheets("icmal")
    sh.Range("A3:N" & Rows.Count) = ""
    sh.Range("A3:N" & Rows.Count).ClearFormats
    
    Set dc1 = CreateObject("scripting.dictionary")
    Set dc2 = CreateObject("scripting.dictionary")
    yil = [E1]
    For i = 1 To UBound(a)
        If Year(a(i, 2)) = yil Then
            ay = Val(Month(a(i, 2)))
            ad = a(i, 1): dc1(ad) = ""
            tutar = ad & "|" & ay: dc2(tutar) = dc2(tutar) + a(i, 3)
        End If
    Next i

If dc1.Count > 0 Then
    say = say + 1
    ReDim b(1 To dc1.Count + 3, 1 To 14)
    For j = 1 To 12
        b(say, j + 1) = Format("1." & j, "mmmm")
    Next j
    ww = dc1.keys
        For i = 1 To dc1.Count
        say = say + 1
            b(say, 1) = ww(i - 1)
            For j = 1 To 12
                krt = ww(i - 1) & "|" & j
                b(say, j + 1) = dc2(krt)
                b(say, 14) = b(say, 14) + dc2(krt)
                b(dc1.Count + 3, j + 1) = b(dc1.Count + 3, j + 1) + b(say, j + 1)
                
            Next j
            b(dc1.Count + 3, 14) = b(dc1.Count + 3, 14) + b(say, 14)
        Next i
 
    sh.[B4].Resize(say + 1, 13).NumberFormat = "#,##0.00"
    sh.[A3].Resize(say, 14).Borders.Color = RGB(1, 0, 1)
    sh.[A3].Offset(say + 1).Resize(, 14).Borders.Color = RGB(1, 0, 1)
    
    sh.[A3].Resize(say + 2, 14) = b
    sh.[A3].Offset(say + 1) = "Toplam"
    sh.[B3].Resize(say, 13).HorizontalAlignment = xlCenter
    sh.Select
    MsgBox "İşlem Bitti.", vbInformation
End If
End Sub

arkadaşlar,rica etsem yukarıdaki kodlara aşagıdaki formülü kod olarak ilave edebilirmisiniz.kullanacağım dosya ektedir.

=EĞERHATA(EĞER(A4="";"";DÜŞEYARA(A4;borç!$B$2:$C$21;2;YANLIŞ)-N4);"")