Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A2")) Is Nothing Then
    Application.EnableEvents = False
Dim i As Long
Dim Dom As String
Dim FoundDom As Range
  Range("B6:B8").ClearContents
   For i = 3 To 8
     If Target >= Cells(i, "M") And Target <= Cells(i, "N") Then
       Dom = Cells(i, "L")
       Set FoundDom = Range("A6:A8").Find(Dom, , xlValues, xlWhole)
       Cells(FoundDom.Row, "B") = Cells(i, "O")
     End If
   Next
  End If
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A2")) Is Nothing Then
    Application.EnableEvents = False
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Dom As String
Dim FoundDom As Range
Dim Zamen As Worksheet
Dim Podpis As Worksheet
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("B6:E" & iLastRow).ClearContents
    Set Zamen = ThisWorkbook.Worksheets("Замещение")
    Set Podpis = ThisWorkbook.Worksheets("Подписанты")
  With Zamen
    iLR = .Cells(.Rows.Count, "B").End(xlUp).Row
   For i = 3 To iLR
     If Target >= .Cells(i, "B") And Target <= .Cells(i, "C") Then
       Dom = .Cells(i, "A")
       Set FoundDom = Range("A6:A" & iLastRow).Find(Dom, , xlValues, xlWhole)
       If .Cells(i, "D") <> "" Then
          Cells(FoundDom.Row, "B") = .Cells(i, "D")
       Else
          Cells(FoundDom.Row, "D") = .Cells(i, "E")
       End If
     End If
   Next
  End With
     For i = 6 To iLastRow
       If Cells(i, "B") = "" Then Cells(i, "B") = Podpis.Cells(i - 4, "B")
       If Cells(i, "D") = "" Then Cells(i, "D") = Podpis.Cells(i - 4, "C")
     Next
  End If
    Application.EnableEvents = True
End Sub