Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim trgt_rng As Range, out_rng As Range
    Dim ws1         As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")    ' Имя листа меняете на своё реальное из книги вашей
    Dim ws2         As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")    ' Имя листа меняете на своё реальное из книги вашей

    If Sh Is ws1 Then

        If Not Intersect(Target, ws1.Range("D:D")) Is Nothing Then
            Application.EnableEvents = False

            For Each Target In Target.Cells

                If Target.Value = "Двери" Or Target.Value = "Ип" Then
                    Set trgt_rng = ws1.Range("D2:D" & ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

                    If Not trgt_rng Is Nothing Then
                        Set out_rng = ws2.Range("D2:D" & ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

                        If Not out_rng Is Nothing Then
                            ws1.Rows(trgt_rng.Row).Copy ws2.Rows(out_rng.Row)
                        Else
                            ws1.Rows(trgt_rng.Row).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row + 1)
                        End If

                    End If

                End If

            Next Target

            Application.CutCopyMode = False
            Application.EnableEvents = True
        End If

    ElseIf Sh Is ws2 Then

        If Not Intersect(Target, ws2.Range("D:D")) Is Nothing Then
            Application.EnableEvents = False

            For Each Target In Target.Cells

                If Target.Value = "Двери" Or Target.Value = "Ип" Then
                    Set trgt_rng = ws2.Range("D2:D" & ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

                    If Not trgt_rng Is Nothing Then
                        Set out_rng = ws1.Range("D2:D" & ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

                        If Not out_rng Is Nothing Then
                            ws2.Rows(trgt_rng.Row).Copy ws1.Rows(out_rng.Row)
                        Else
                            ws2.Rows(trgt_rng.Row).Copy ws1.Rows(ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row + 1)
                        End If

                    End If

                End If

            Next Target

            Application.CutCopyMode = False
            Application.EnableEvents = True
        End If

    End If

    Set ws2 = Nothing
    Set ws1 = Nothing
    Set out_rng = Nothing
    Set trgt_rng = Nothing
End Sub