Excelin geç kapanma sorunu

[yavuz829]

Merhaba arkadaşlar excel dosyamı kapatmak istediğim zaman kayıt yapıyor, kayıt yaptığı halde tekrar yaptığınız değişiklikleri kaydetmek istiyormusun sorunu soruyor. Bu nedenle dosyam çok geç kapanıyor. Kapat dediğim zaman otomotikmen kayıt yapsın ve kapansın. Tekrar değişiklikleri kaydetmek istiyormusun sorusunu sormasın. Bu konuda yardımlarınızı bekliyorum.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWindow.TabRatio = 0.018
Sheets("liste").Select
ActiveSheet.Unprotect "123"
Application.ScreenUpdating = False
Set Sİ = Sheets("liste")
Sİ.[A3:F1000].ClearContents
For Z = 3 To Sheets.Count
Sİ.Cells(SAT + 1, 1) = Sheets(Z).[A1].Value
Sİ.Cells(SAT + 1, 2) = Sheets(Z).[G3].Value
Sİ.Cells(SAT + 1, 3) = Sheets(Z).[G4].Value
Sİ.Cells(SAT + 1, 4) = Sheets(Z).[I3].Value
Sİ.Cells(SAT + 1, 5) = Sheets(Z).[I4].Value
Sİ.Cells(SAT + 1, 6) = Sheets(Z).[K3].Value
SAT = SAT + 1
Next
son = Cells(65536, "f").End(xlUp).Row + 1
Cells(son, "f") = WorksheetFunction.Sum(Range("f3:f65536"))
Cells(son, "e") = WorksheetFunction.Sum(Range("e3:e65536"))
Cells(son, "d") = WorksheetFunction.Sum(Range("d3:d65536"))
Cells(son, "c") = WorksheetFunction.Sum(Range("c3:c65536"))
Cells(son, "b") = WorksheetFunction.Sum(Range("b3:b65536"))
Application.ScreenUpdating = True
ActiveSheet.Protect "123"
Sheets("sayfa1").Select
ThisWorkbook.Save
Application.Quit
End Sub