Попробуй это:
Private Sub Worksheet_Change(ByVal Target As Range) Dim E As Range, H As Range, Inte As Range, r As Range Set E = Range("E:E") Set H = Range("H:H") Set Inte = Intersect(E, Target) If Not Inte Is Nothing Then Application.EnableEvents = False For Each r In Inte r.Offset(0, 1).Value = Date Next r Application.EnableEvents = True End If Set Inte = Intersect(H, Target) If Not Inte Is Nothing Then Application.EnableEvents = False For Each r In Inte r.Offset(0, 1).Value = Date Next r Application.EnableEvents = True End If End Sub
Вместо выхода из подпрограммы, когда пересечение - ничто, проверьте на противоположность ничто и запустите код на каждом пересечении отдельно.
Обратите внимание, я объявил H как диапазон и удалил неиспользованное объявление F как диапазон.