Sub z3_b()
Dim i, j, CurValue, lastrow, lastrow1, k, n, x As Integer
Dim d1, d2, d3, d4 As Date
Dim Name As String

Dim engeneer, engeneerFound As Boolean
Dim page1, page2 As Object

Set page1 = Worksheets("Êòî åäåò")
Set page2 = Worksheets("Ñïèñîê èíæåíåðîâ")
engeneer = False
engeneerFound = False

lastrow = page1.Cells(1, 1).CurrentRegion.Rows.Count
lastrow1 = page2.Cells(1, 1).CurrentRegion.Rows.Count
i = 2
While (i <> lastrow And i < lastrow)
   engeneer = False
    CurValue = Cells(i, 1).Value
    If Cells(i, 7).Value = "Èñïûòàíèÿ" Then
        j = i
        Do While Cells(j, 1) = CurValue
            If Cells(j, 3).Value Like "*èíæåíåð*" Then
                engeneer = True
                Exit Do
            End If
            j = j + 1
        Loop
        If Not engeneer Then
        
        'èùåì èíæåíåðà, êîòîðûé ïðè ýòîì ñâîáîäåí äëÿ äàííîé êîìàíäèðîâêè (ò.å. ïåðèîäû âñåõ åãî êîìàíäèðîâîê íå ïåðåñåêàþòñÿ ñ äàííîé)
            d1 = page1.Cells(j - 1, 4)
            d2 = DateAdd("d", d1, page1.Cells(j - 1, 5))
            For k = 2 To lastrow1 - 1
                d3 = page2.Cells(k, 4)
                d4 = DateAdd("d", d3, page2.Cells(k, 5))
                If ((d2 < d3) Or (d1 > d4)) Then
                    For x = k + 1 To lastrow1
                        If page1.Cells(x, 2) = page1.Cells(k, 2) Then
                        d3 = page2.Cells(x, 4)
                        d4 = DateAdd("d", d3, page2.Cells(x, 5))
                            If ((d2 < d3) Or (d1 > d4)) Then
                            x = x + 1
                            Else
                            Exit For
                            If x = lastrow1 Then
                                n = k
                                engeneerFound = True
                                Exit For
                            End If
                            End If
                        End If
                    Next x
                End If
            If engeneerFound = True Then
                 page1.Range(page1.Cells(j, 1), page1.Cells(lastrow, 7)).Copy
                page1.Range(page1.Cells(j + 1, 1), page1.Cells(lastrow + 1, 7)).PasteSpecial
                page2.Rows(n).Copy
                page1.Rows(j).PasteSpecial
                Cells(j, 1) = CurValue
                Cells(j, 4) = Cells(j - 1, 4)
                Cells(j, 5) = Cells(j - 1, 5)
                Cells(j, 7) = Cells(j - 1, 7)
                Rows(j).Interior.ColorIndex = 50
                lastrow = lastrow + 1
            End If
            Next k
        End If
    End If
    
    Do While Cells(i, 1) = CurValue
        i = i + 1
    Loop
Wend
End Sub