Soru Kodun çok yavaş çalışması

[Cengizhantr06]

Private Sub CommandButton52_Click()
Application.ScreenUpdating = False
Dim cevap As Variant
cevap = MsgBox("TÜM VERİLER SİLİNECEK... Onaylıyormusunuz..?", vbYesNoCancel, "bildiri")
If cevap = vbYes Then
Sheets("10gun").Range("A4:I200").ClearContents
Sheets("girisler").Range("A2:K4000").ClearContents
ongunSayfasicoketopla
topla
UserForm_Initialize

MsgBox "TÜM VERİLER SİLİNDİ", vbInformation, "POS TAKİP"

Else
Exit Sub
End If
Application.ScreenUpdating = True
End Sub

yukardaki kod çok yavaş aşırı yavaş çünkü girişler sayfasında change kısmında alttaki şu kod olduğu için kasıyor başka bi çaresi yada
hızlanması için ne yapabilirim

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Veri As Range

If Intersect(Target, Range("E2:E" & Rows.Count)) Is Nothing Then Exit Sub

For Each Veri In Intersect(Target, Range("E2:E" & Rows.Count))
If IsDate(Veri.Value) Then
Select Case Weekday(Veri.Value, vbMonday)
Case 6: Veri.Offset(0, 1) = Veri.Value + 2
Case 7: Veri.Offset(0, 1) = Veri.Value + 1
Case Else: Veri.Offset(0, 1) = Veri.Value
End Select
ElseIf Veri.Value = "" Or Not IsNumeric(Veri.Value) Then
Veri.Offset(0, 1).ClearContents
End If
Next

End Sub

 

[muratboz06]

Deneyiniz.

Private Sub CommandButton52_Click()
Dim cevap As Variant
cevap = MsgBox("TÜM VERİLER SİLİNECEK... Onaylıyormusunuz..?", vbYesNoCancel, "bildiri")
If cevap = vbYes Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("10gun").Range("A4:I200").ClearContents
Sheets("girisler").Range("A2:K4000").ClearContents
ongunSayfasicoketopla
topla
UserForm_Initialize

MsgBox "TÜM VERİLER SİLİNDİ", vbInformation, "POS TAKİP"

Else
Exit Sub
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Cengizhantr06]

Deneyiniz.

Private Sub CommandButton52_Click()
Dim cevap As Variant
cevap = MsgBox("TÜM VERİLER SİLİNECEK... Onaylıyormusunuz..?", vbYesNoCancel, "bildiri")
If cevap = vbYes Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("10gun").Range("A4:I200").ClearContents
Sheets("girisler").Range("A2:K4000").ClearContents
ongunSayfasicoketopla
topla
UserForm_Initialize

MsgBox "TÜM VERİLER SİLİNDİ", vbInformation, "POS TAKİP"

Else
Exit Sub
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Çok teşekkür ederim Murat bey