Satır Silerken yavaşlama Oluyor..!

[sensizsoldum]

Merhaba
Aşağıdaki kodda minik bir sorun alıyorum, aslında sorun olduğu da söylenemez. Sadece kodun olduğu sayfa da satır silerken çok geç siliyor. Aslında satır silerken, hiç yavaşlama olmaması gerekiyor. Bir satırı minimum sn. siliyor. Ben onlarca satır siliyorum. İşlerimde çok aksatma yapıyor. Nasıl bir düzenleme yapabiliriz.
Kodlar aşağıdadır.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Count = 1 Then
If Intersect(Target, Range("A3:A" & Rows.Count)) Is Nothing Then Exit Sub
If Target <> Empty Then
Cells(Target.Row, "G") = 1
Else
Cells(Target.Row, "G") = Empty
End If
ElseIf Target.Count > 1 Then
For A = Target.Row To Target.Row + Target.Count
If Cells(A, "A") <> Empty Then
Cells(A, "G") = 1
Else
Cells(A, "G") = Empty
End If: Next: End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub