Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Application.EnableEvents = False
If Intersect(Target, Range("a2:a3000")) Is Nothing Then Exit Sub
For i = 2 To 7
If Cells(i, 1).Address = "$A$" & i Then Cells(i, 4) = Cells(i, 1)
Next i
Application.EnableEvents = True
End Sub