請問 Excel VBA 的 執行速度問題

小弟在製作excel 的異動紀錄遇到一個問題:

一般使用上，都會正常紀錄 新增、修改、刪除
但只要使用內建篩選後，在編輯儲存格時就會一直跑圈圈?執行速度變得很慢
不知道程式碼上，還能從哪裡改進，麻煩大大們幫忙

程式碼如下:
--------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
xr = Target.Row
yr = Target.Column
xrow = Sheets("設備異動紀錄").UsedRange.Rows.Count
x = Cells(xr, yr)
y = Sheets("備份").Cells(xr, yr)
If x = "" Then
If y <> "" Then
Call 紀錄("刪除", xrow, xr, yr, x, y)
End If
Else
If y = "" Then
Call 紀錄("新增", xrow, xr, yr, x, y)
Else
If y <> x Then
Call 紀錄("修改", xrow, xr, yr, x, y)
End If
End If
End If
End Sub

-------------------------------------------------------------------------------------------------------------
Sub 紀錄(Name, xrow, xr, yr, x, y)
Sheets("設備異動紀錄").Cells(xrow + 1, 1) = Now()
Sheets("設備異動紀錄").Cells(xrow + 1, 2) = Cells(xr, 1)
Sheets("設備異動紀錄").Cells(xrow + 1, 3) = Cells(xr, 2)
Sheets("設備異動紀錄").Cells(xrow + 1, 4) = Cells(1, yr)
Sheets("設備異動紀錄").Cells(xrow + 1, 5) = Name
Sheets("設備異動紀錄").Cells(xrow + 1, 6) = y
Sheets("設備異動紀錄").Cells(xrow + 1, 7) = x
Sheets("設備異動紀錄").Cells(xrow + 1, 8) = "row:" & xr
Sheets("設備異動紀錄").Cells(xrow + 1, 9) = "col:" & yr
Application.Calculation = xlCalculationAutomatic
End Sub
--------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xr = Target.Row
yr = Target.Column
x = Cells(xr, yr)
Sheets("備份").Cells.Clear
Cells.Copy Sheets("備份").Cells(1, 1)
Application.CutCopyMode = False
Cells(xr, yr).Select
End Sub