Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("H3:H9000")) Is Nothing Then
Target.Offset(0, -1).Resize(1, 2).Copy Target.Offset(0, -4)
Target.Offset(0, -1) = DateSerial(Year(Target.Offset(0, -1)) + 1, Month(Target.Offset(0, -1)), Day(Target.Offset(0, -1)))
Target = DateSerial(Year(Target) + 1, Month(Target), Day(Target))
Cancel = True
End If
End Sub