Merhaba Arkadaşlar

Eklediğim uygulamada M6 hücresine tarih yazıp aktar butonuna bastığım zaman o tarihteki işlem yapan gelir ve gideri Sayfa2 ye aktarsın. Kişi bazında toplam olarak Sayfa2 de alt, alta göstersin.

Örneğin: 02.01.2021 yazıp aktar komutunu verdiğim zaman o tarihte Ayşen'in yaptığı işlemlerin toplamını birinci satıra, Keremin yaptığı işlemin toplamını bir alt satıra ve Mehmet'in yaptığı işlemin toplamlarını üçüncü satırda göstersin ve  en alt bir satır boş bırakarak genel toplamları göstersin.

Bu konuda yardımlarınıza ihtiyacım var. Yardımlarınız için şimdiden teşekkürler.

Arkadaşlar Sorunumu Çoketopla ile çözdüm.

İşlem Yapan boş bırakıldığı zaman aktarma yapmıyor.
Benim istediğim eğer İşlem Yapan hücresi boş ise M6 hücresindeki tarihe göre Gelir ve Giderdeki işlem tutarlarını Sayfa2 deki satır 2 ye aktarsın.
Bunun için aşağıdaki kodu nasıl değiştirebilirim.

Merhaba.
Formül olarak yukardaki gibi kısatılıabilinir M6 kısmını.
Kod ile yapınca eklerim.

Sub CokeToplaa()

    Dim son As Long, i As Long

    Dim syf As Worksheet

    Set syf = ThisWorkbook.Sheets("Sayfa2")

    Const satir_bas As Byte = 2

    

    With ThisWorkbook.Sheets("Sayfa1")

        son = syf.Range("A:A").Find("GENEL TOPLAM", , , 1).Row - 1

        syf.Range("B" & satir_bas & "" & son + 1).Value = ""



        

        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("GENEL TOPLAM", , , 1).Row

        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

    Set syf = Nothing

    MsgBox "Biiti"

End Sub

Alttaki kodda gifteki gibi çalışır.


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

Hocam kodu ekledim hata veriyor.

Kodu eklediğim dosyama uygularmısınız.

Hocam Excel sayfa ve çalışma kitap koruması var.