Çözüldü Farklı sayfalardan gelir defteri oluşturmak

Üstadım dediklerinizi yaptım. Ancak H4 e yazdığım rakamı siliyor toplama dahil etmiyor. Bir türlü çözemedim. Kodun son halini atıyorum.

Sub DEFTER_OLUSTUR()
Set g = Sheets("GELİR DEFTERİ"): Set k = Sheets("KULÜPLER")
On Error GoTo bitir
liste = 32: bosluk = 6: baslik = 4
ay1 = Sheets("GİRİŞ").[AK3]
zaman = Timer
Call TEMIZLE
'For klp = 3 To WorksheetFunction.Max(k.[A:A]) + 2
' evet = 0
' If k.Cells(klp, 2) <> "" Then
' shf = k.Cells(klp, 2)
' On Error Resume Next
' varmi = 0: varmi = Len(Sheets(shf).Name)
' If varmi = 0 Then GoTo 10
' On Error GoTo bitir
' Set kulup = Sheets(shf)
' sonk = WorksheetFunction.Max(kulup.[A:A]) + 5
' If sonk = 5 Then GoTo 10
' bu = IIf(ay1 = 1, 0, WorksheetFunction.Sum(kulup.Range(kulup.Cells(6, 5), kulup.Cells(50, ay1 + 3))))
' kdevir = kdevir + bu
' End If
'10: Next
devir = g.[H4]
Sheets("GİRİŞ").[AK3] = ay1

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
g.[G4] = "DEVİR": g.[H4] = devir
For klp = 3 To WorksheetFunction.Max(k.[A:A]) + 2
If k.Cells(klp, 2) <> "" Then
shf = k.Cells(klp, 2)
On Error Resume Next
varmi = 0
varmi = Len(Sheets(shf).Name)
If varmi = 0 Then GoTo 20
On Error GoTo bitir
Set kulup = Sheets(shf)
sonk = WorksheetFunction.Max(kulup.[A:A]) + 5
'sonk = WorksheeFunction.CountIf(kulup.Range(kulup.Cells(6, ay1 + 3), kulup.Cells(50, ay1 + 3)), ">0")
If sonk = 5 Then GoTo 20

For ksat = 6 To sonk
If kulup.Cells(ksat, ay1 + 4) > 0 Then
If evet > 0 And evet Mod 32 = 0 Then 'evet = 31 Then
gsat = gsat + 11
g.Range("A1:H4").Copy g.Cells(gsat - 4, 1)
g.Rows(gsat - 4).RowHeight = g.Rows(1).RowHeight
g.Rows(gsat - 3).RowHeight = g.Rows(2).RowHeight
g.Rows(gsat - 2).RowHeight = g.Rows(3).RowHeight
g.Rows(gsat - 1 & ":" & gsat + 37).RowHeight = 19.5
g.Cells(gsat - 1, 8) = g.Cells(gsat - 11, 8)
g.Range("A5:H36").Copy: g.Cells(gsat, 1).PasteSpecial Paste:=xlPasteFormats
Else
gsat = g.Cells(Rows.Count, 7).End(3).Row + 1
End If
evet = evet + 1: g.Cells(gsat, 1) = evet: g.Cells(gsat, 9) = shf
g.Cells(gsat, 4) = kulup.Cells(ksat, 3): g.Cells(gsat, 5) = kulup.Cells(ksat, 2)
g.Cells(gsat, 6) = kulup.Cells(ksat, 4): g.Cells(gsat, 7) = kulup.Cells(ksat, ay1 + 4)
g.Cells(gsat, 8) = g.Cells(gsat - 1, 8) + kulup.Cells(ksat, ay1 + 4)
g.[A4] = g.[A4] + 1: g.[I4] = g.Cells(gsat, 8)
End If
Next
End If
20: Next
bitir: g.[K1] = "'= " & formul
g.PageSetup.PrintArea = "A1:H" & WorksheetFunction.CountIf(g.[G:G], "DEVİR") * 42
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "İşlem tamamlandı.." & vbLf & "İşlem sürsi: " & Format(Timer - zaman, 0#) & " saniye", vbInformation, "::.. Ömer BARAN ..::"
End Sub

Bir ufak dokunuş daha gerek sanırım. Saygılar sunuyorum.

TEMIZLE isimli makro kodunda şuraya + 1 'i ekleyin.

g.Range("A" & baslik + 1 & ":I" & liste + baslik + bosluk).ClearContents

Üstadım çok teşekkür ediyorum. Çok sağolun