Farklı Gider ve Gelirleri Bir Ekstrede Nasıl Toplayabilirim?

[gokhanruscuk]

Merhabalar,

Ektede anlatmış olduğum gibi farklı gider ve gelir gruplarında gerçekleşen birçok işlem için toplu bir ekstre sayfası yaratmak istiyorum.

Teşekkürler,

 

[Vedat Özer]

Selamlar

Çalışma kitabınızın Thisworkbook bölümüne aşagıdaki kodu yapıştırıp dosyanızı açıp sonra tekrar açıp deneme yapın,

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ts
Application.EnableEvents = False
If ActiveSheet.Name = "GİDER" Then
If Target.Column = 3 Then
If Intersect(Target, Range("C3:C" & Rows.Count)) Is Nothing Then Exit Sub
ts = Sheets("EKSTRE").Range("A" & Rows.Count).End(xlUp).Row
Sheets("EKSTRE").Range("A" & ts + 1) = Cells(Target.Row, "A")
Sheets("EKSTRE").Range("B" & ts + 1) = Cells(Target.Row, "B")
Sheets("EKSTRE").Range("C" & ts + 1) = 0
Sheets("EKSTRE").Range("D" & ts + 1) = Cells(Target.Row, "C")
Sheets("EKSTRE").Range("C2") = WorksheetFunction.Sum(Sheets("EKSTRE").Range("C3:C" & Rows.Count))
Sheets("EKSTRE").Range("D2") = WorksheetFunction.Sum(Sheets("EKSTRE").Range("D3:D" & Rows.Count))
ElseIf Target.Column = 7 Then
If Intersect(Target, Range("G3:G" & Rows.Count)) Is Nothing Then Exit Sub
ts = Sheets("EKSTRE").Range("A" & Rows.Count).End(xlUp).Row
Sheets("EKSTRE").Range("A" & ts + 1) = Cells(Target.Row, "E")
Sheets("EKSTRE").Range("B" & ts + 1) = Cells(Target.Row, "F")
Sheets("EKSTRE").Range("C" & ts + 1) = 0
Sheets("EKSTRE").Range("D" & ts + 1) = Cells(Target.Row, "G")
Sheets("EKSTRE").Range("C2") = WorksheetFunction.Sum(Sheets("EKSTRE").Range("C3:C" & Rows.Count))
Sheets("EKSTRE").Range("D2") = WorksheetFunction.Sum(Sheets("EKSTRE").Range("D3:D" & Rows.Count))
End If
ElseIf ActiveSheet.Name = "GELİR" Then
If Target.Column = 3 Then
If Intersect(Target, Range("C3:C" & Rows.Count)) Is Nothing Then Exit Sub
ts = Sheets("EKSTRE").Range("A" & Rows.Count).End(xlUp).Row
Sheets("EKSTRE").Range("A" & ts + 1) = Cells(Target.Row, "A")
Sheets("EKSTRE").Range("B" & ts + 1) = Cells(Target.Row, "B")
Sheets("EKSTRE").Range("C" & ts + 1) = Cells(Target.Row, "C")
Sheets("EKSTRE").Range("D" & ts + 1) = 0
Sheets("EKSTRE").Range("C2") = WorksheetFunction.Sum(Sheets("EKSTRE").Range("C3:C" & Rows.Count))
Sheets("EKSTRE").Range("D2") = WorksheetFunction.Sum(Sheets("EKSTRE").Range("D3:D" & Rows.Count))
End If
End If
Application.EnableEvents = True
End Sub

 

[gokhanruscuk]

Teşekkür

Valla Vedat Bey, on numarasın teşekkür ederim.Öğlen yaptığında iyiydi ama formüller bana fazla geldi.Kendime uyarlayamadım.Bu tam istediğim gibi oldu.

Allah razı olsun