Sub z_3()
Dim i, j, CurValue, lastrow, lastrow1, k, n As Integer

Dim d1, d2, d3, d4 As Date

Dim perevodchik As Boolean
perevodchik = False

lastrow = Worksheets("Кто едет").Cells(1, 1).CurrentRegion.Rows.Count
lastrow1 = Worksheets("Список переводчиков").Cells(1, 1).CurrentRegion.Rows.Count
i = 2
While (i <> lastrow And i < lastrow)
	perevodchik = False
        CurValue = Cells(i, 1).Value
		j = i
		Do While Cells(j, 1) = CurValue

			If Cells(j, 3) Like "*переводчик*" Then 'косяк
			perevodchik = True
			Exit Do
			End If
			j = j + 1
			Loop
		If Not perevodchik Then

'ищем переводчика, который при этом свободен для данной командировки (т.е. периоды всех его командировок не пересекаются с данной)
			For k = 2 To lastrow1
			d1 = Sheets("Кто едет").Cells(j - 1, 4)
			d2 = Sheets("Кто едет").Cells(j - 1, 5)
			d3 = Sheets("Список переводчиков").Cells(k, 4)
			d4 = Sheets("Список переводчиков").Cells(k, 5)
				If ((d1 < d3) And (d2 < d3)) Or ((d1 > d3) And (d1 > d4)) Then
				n = k
				Exit For
				End If
				Next k
				Sheets("Кто едет").Range(Sheets("Кто едет").Cells(j, 1), Sheets("Кто едет").Cells(lastrow, 6)).Copy
				Sheets("Кто едет").Range(Sheets("Кто едет").Cells(j + 1, 1), Sheets("Кто едет").Cells(lastrow + 1, 6)).PasteSpecial
				Sheets("Список переводчиков").Rows(n).Copy
				Sheets("Кто едет").Rows(j).PasteSpecial
				Cells(j, 1) = CurValue
				Cells(j, 4) = Cells(j - 1, 4)
				Cells(j, 5) = Cells(j - 1, 5)
				Cells(j, 6) = "заграничная"
				lastrow = lastrow + 1
				End if

	End If

Do While Cells(j, 1) = CurValue
        i = i + 1
    Loop
Wend
End Sub