Private Sub worksheet_change(ByVal Target As Range)
Dim h, iSct As Range
Set iSct = Intersect(Target, Range("B2:B50000"))
If iSct Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each h In iSct.Cells
If IsEmpty(h) Then
h.Offset(0, -1) = ""
ElseIf h.Offset(0, -1) <> "" Then
Exit sub
Else
h.Offset(0, -1) = Format(Now, "yyyy")
End If
Next
Application.EnableEvents = True
End Sub