fejl i makro der kopierer værdier fra celler ovenfor

Jeg har kontrueret denne makro der kopierer data fra linjen ovenfor, når jeg har indtastet data i kolonne A.
Men den går ned nogle gange hvis jeg sletter noget i kolonne A.
Deter som om den looper og så går ned
Er der nogen der kan se hvad jeg evt. gør galt?



Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo fejl
'ScrollArea = "A:G"
    If Not Intersect(Target, Range("A3:A500")) Is Nothing Then
        If ActiveCell.Offset(0, 0) = "" And ActiveCell.Offset(0, 1) = "" Then
            ' først kopieres dato
            ActiveCell.Offset(-1, 0).Range("A1").Select
            Selection.Copy
            ActiveCell.Offset(1, 0).Range("A1").Select
            ActiveSheet.Paste
            ActiveCell.Select
            ' så kopieres initialer
            ActiveCell.Offset(-1, 1).Range("A1").Select
            Selection.Copy
            ActiveCell.Offset(1, 0).Range("A1").Select
            ActiveSheet.Paste
            ActiveCell.Select
            ' går til celle med tid
            ActiveCell.Offset(0, 1).Range("A1").Activate
           
        End If
    End If

fejl:
End Sub