# Sub z3_b Dim CurValue lastrow lastrow1 As Integer Dim d1 d2 d3 d4 As D

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70``` ```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 = page1.Cells(j - 1, 5) d3 = page2.Cells(k, 4) d4 = 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 = 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 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 ```