Dim wb_source As Workbook
Dim wb_result As Workbook
Function create_book()
Set wb_source = ActiveWorkbook
Set wb_result = Workbooks.Add
End Function

Function deleteSheets()
For i = 2 To wb_result.Sheets.Count
    wb_result.Sheets(i).Delete
Next i
End Function
Function sheetEmpty(sheet As Worksheet) As Boolean
    If sheet.UsedRange.Rows.Count > 1 Then
       sheetEmpty = False
    Else
       sheetEmpty = True
    End If
End Function



Function pr()
Dim a, b As Worksheet
Set a = wb_source.Sheets(2)
Set b = wb_source.Sheets(3)
a.Range("A1:G" & a.UsedRange.Rows.Count).Copy



Dim temp As Integer

Dim res_sh As Worksheet
If sheetEmpty(wb_result.Sheets(wb_result.Sheets.Count)) Then
Set res_sh = wb_result.Sheets(wb_result.Sheets.Count)
Else
Set res_sh = wb_result.Sheets.Add
End If
res_sh.Range("A1").PasteSpecial
res_sh.Range("A1:G" & a.UsedRange.Rows.Count).Columns.AutoFit
For i = 2 To a.UsedRange.Rows.Count
On Error Resume Next

temp = WorksheetFunction.VLookup(Cells(i, 4), b.Range("A2:B" & b.UsedRange.Rows.Count), 2, 0)
On Error GoTo 0
If temp <> 0 Then
 If Cells(i, 3) > temp Then
  res_sh.Range("A" & i, "G" & i).Interior.ColorIndex = 34
  res_sh.Cells(i, 3).Value = temp
 End If
End If
temp = 0
Next i
 
End Function

Function task2()
Dim a, b As Worksheet
Set a = wb_source.Sheets(2)
Set b = wb_source.Sheets(8)
Set namesCom = wb_source.Sheets(1)
Set namesCom1 = wb_result.Sheets.Add
namesCom.Range("A1:B" & namesCom.UsedRange.Rows.Count).Copy Destination:=namesCom1.Range("A1")
temp = ""
Set d = wb_result.Sheets.Add
For i = 2 To a.UsedRange.Rows.Count
On Error Resume Next
temp = WorksheetFunction.VLookup(a.Cells(i, 5).Value, b.Range("A2:A" & b.UsedRange.Rows.Count), 1, 0)
On Error GoTo 0
    If temp <> "" Then
        namesCom.Range("A1:B" & namesCom.UsedRange.Rows.Count).AutoFilter Field:=1, Criteria1:=a.Cells(i, 1).Value
        namesCom.AutoFilter.Range.Copy Destination:=d.Range("A1")
        namesCom.Range("A1:B" & namesCom.UsedRange.Rows.Count).AutoFilter Field:=1
        check = False
        For j = 2 To d.UsedRange.Rows.Count
            job = ""
            On Error Resume Next
            job = WorksheetFunction.VLookup(d.Cells(j, 2).Value, wb_source.Sheets(4).Range("A2:D" & wb_source.Sheets(4).UsedRange.Rows.Count), 4, 0)
            job = WorksheetFunction.VLookup(d.Cells(j, 2).Value, wb_source.Sheets(5).Range("A2:L" & wb_source.Sheets(5).UsedRange.Rows.Count), 4, 0)
            job = WorksheetFunction.VLookup(d.Cells(j, 2).Value, wb_source.Sheets(6).Range("A2:C" & wb_source.Sheets(6).UsedRange.Rows.Count), 3, 0)
            On Error GoTo 0
            If InStr(job, "переводчик") <> 0 Then
                check = True
                Exit For
              
            End If
        Next j
        d.Cells.Clear
        If check = False Then
            For j = 2 To wb_source.Sheets(4).UsedRange.Rows.Count
                check2 = False
                If InStr(wb_source.Sheets(4).Cells(j, 4).Value, "переводчик") <> 0 Then
                   namesCom.Range("A1:B" & namesCom.UsedRange.Rows.Count).AutoFilter Field:=2, Criteria1:=wb_source.Sheets(4).Cells(j, 1).Value
                   namesCom.AutoFilter.Range.Copy Destination:=d.Range("A1")
                   namesCom.Range("A1:B" & namesCom.UsedRange.Rows.Count).AutoFilter Field:=2
                   num = ""
                   For k = 2 To d.UsedRange.Rows.Count
                    num = WorksheetFunction.Match(d.Cells(k, 1).Value, a.Range("A1:A" & a.UsedRange.Rows.Count), 0)
                    If a.Cells(num, 2).Value + a.Cells(num, 3).Value < a.Cells(i, 2).Value Or a.Cells(i, 2).Value + a.Cells(i, 3).Value < a.Cells(num, 2) Then
                        namesCom1.Cells(namesCom.UsedRange.Rows.Count + 1, 2) = d.Cells(2, 2).Value
                        namesCom1.Cells(namesCom.UsedRange.Rows.Count + 1, 1) = a.Cells(i, 1).Value
                        namesCom1.Range("A" & namesCom.UsedRange.Rows.Count + 1, "B" & namesCom.UsedRange.Rows.Count + 1).Interior.ColorIndex = 34
                        check2 = True
                        d.Cells.Clear
                        Exit For
                    End If
                   Next k
                End If
                If check2 = True Then
                    Exit For
                End If
                d.Cells.Clear
            Next j
        End If
    End If
    temp = ""
    
Next i
    namesCom1.Range("A2:B" & namesCom1.UsedRange.Rows.Count).Sort key1:=namesCom1.Range("A2"), Order1:=xlAscending
    namesCom1.Range("A1:B" & namesCom.UsedRange.Rows.Count).Columns.AutoFit
    d.Delete
End Function