https://resim.accesstr.net/do.php?img=11051
Sub CokeToplaa()
Dim son As Long, i As Long
Dim syf As Worksheet
Set syf = ThisWorkbook.Sheets("Sayfa2")
Dim bulGenel As Range
Const satir_bas As Byte = 2
With ThisWorkbook.Sheets("Sayfa1")
syf.Range("B" & satir_bas & "
" & Rows.Count).ClearContents
Set bulGenel = syf.Range("A:A").Find("GENEL TOPLAM", , , 1)
If Not bulGenel Is Nothing Then Rows(bulGenel.Row).Delete
son = syf.Range("A:A").Find("*", , , , , xlPrevious).Row
If son < satir_bas Then Exit Sub
If son = satir_bas Then son = satir_bas
For i = satir_bas To son
syf.Cells(i, 2).Value = WorksheetFunction.SumIfs(.Range("D"), _
.Range("A:A"), syf.Cells(i, 1).Value, _
.Range("B:B"), .Cells(6, "M").Value)
syf.Cells(i, 3).Value = WorksheetFunction.SumIfs(.Range("i:i"), _
.Range("F:F"), syf.Cells(i, 1).Value, _
.Range("G:G"), .Cells(6, "M").Value)
syf.Cells(i, 4).Value = syf.Cells(i, 2).Value - syf.Cells(i, 3).Value
Next
son = syf.Range("A:A").Find("*", , , , , xlPrevious).Row + 2
syf.Range("A" & son).Value = "GENEL TOPLAM"
syf.Range("B" & son).Value = WorksheetFunction.Sum(syf.Range("B" & satir_bas & ":B" & son - 1))
syf.Range("C" & son).Value = WorksheetFunction.Sum(syf.Range("C" & satir_bas & ":C" & son - 1))
syf.Cells(son, 4).Value = syf.Cells(son, 2).Value - syf.Cells(son, 3).Value
End With
On Error Resume Next
Set syf = Nothing: Set bulGenel = Nothing
On Error GoTo 0
MsgBox "Biiti"
End Sub