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 As Boolean
Dim page1, page2 As Object

Set page1 = Worksheets("Кто едет")
Set page2 = Worksheets("Список инженеров")
engeneer = 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
        
        'ищем инженера, который при этом свободен для данной командировки (т.е. периоды всех его командировок не пересекаются с данной)
            For k = 2 To lastrow1 - 1
                d1 = page1.Cells(j - 1, 4)
                d2 = DateAdd("d", d1, page1.Cells(j - 1, 5))
                d3 = page2.Cells(k, 4)
                d4 = DateAdd("d", d3, page2.Cells(k, 5))
                If ((d1 < d3) And (d2 < d3)) Or ((d1 > d3) And (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 ((d1 < d3) And (d2 < d3)) Or ((d1 > d3) And (d1 > d4)) Then
                            x = x + 1
                            Else
                            Exit For
                            If x = lastrow1 Then
                                n = k
                                Exit For
                            End If
                            End If
                        End If
                    Next x
                End If
            Next k
            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
    End If
    
    Do While Cells(i, 1) = CurValue
        i = i + 1
    Loop
Wend
End Sub