Option Explicit
 
Const SKUD_XLS1 = "Отчет1.xls"
Const SKUD_XLS2 = "Отчет2.xls"
Const TABL_XLSX = "Учет рабочего времени.xls"
 
Sub ИзОтчетаВТабель()
    Dim wbS As Workbook
    Dim wb2 As Workbook
    Dim wbT As Workbook
    On Error Resume Next
    Set wbS = Workbooks(SKUD_XLS1)
    Set wb2 = Workbooks(SKUD_XLS2)
    Set wbT = Workbooks("Учет рабочего времени.xls")
    On Error GoTo 0
    If wbS Is Nothing And wb2 Is Nothing Then
        MsgBox "Не найдены файлы " & vbCrLf & SKUD_XLS1 & vbCrLf & SKUD_XLS2, vbInformation
    Else
        If wbT Is Nothing Then
            MsgBox "Не найден файл " & TABL_XLSX, vbInformation
        Else
            
            Dim dicY As Object
            Dim dicX As Object
            GetDic wbT.Sheets(1), dicY, dicX
            
            Dim arrSkud As Variant
            If Not wbS Is Nothing Then
                arrSkud = GetArrSkud1(wbS.Sheets(1))
                PrintResult wbT.Sheets(1), wbS.Sheets(1), arrSkud, dicY, dicX
            End If
            If Not wb2 Is Nothing Then
                arrSkud = GetArrSkud2(wb2.Sheets(1))
                PrintResult wbT.Sheets(1), wb2.Sheets(1), arrSkud, dicY, dicX
            End If
        End If
    End If
End Sub
 
Sub PrintResult(sh As Worksheet, shSKUD As Worksheet, arrSkud As Variant, dicY As Object, dicX As Object)
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    With sh
        Dim rep As Variant
        ReDim rep(1 To UBound(arrSkud, 1), 1 To 1)
         
        Dim i As Byte
        Dim x As Integer
        Dim y As Long
        Dim ySkud As Long
        For ySkud = 1 To UBound(arrSkud, 1)
            If arrSkud(ySkud, 1) <> "" Then
                rep(ySkud, 1) = "-"
                If dicY.Exists(arrSkud(ySkud, 1)) Then
                    If dicX.Exists(CStr(arrSkud(ySkud, 2))) Then
                        rep(ySkud, 1) = "+"
                        y = dicY.Item(arrSkud(ySkud, 1))
                        x = dicX.Item(CStr(arrSkud(ySkud, 2)))
                        For i = 0 To 1
                            If arrSkud(ySkud, 3 + i) <> "" Then
                                .Cells(y, x + i).Value = arrSkud(ySkud, 3 + i)
                            End If
                        Next
                    End If
                End If
            End If
        Next
    End With
     
    shSKUD.Cells(1, 15).Resize(UBound(rep, 1), UBound(rep, 2)) = rep
    Application.EnableEvents = True
    Application.Calculation = Application_Calculation
End Sub
 
Function GetArrSkud1(sh As Worksheet) As Variant
    Dim arr As Variant
    Dim brr As Variant
    Dim y As Long
    
    With sh
        y = .Cells(.Rows.Count, 3).End(xlUp).Row
        arr = .Range(.Cells(1, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 8))
    End With
    ReDim brr(1 To UBound(arr, 1), 1 To 4)
    For y = 1 To UBound(arr, 1)
        brr(y, 1) = arr(y, 1)
        brr(y, 2) = arr(y, 2)
        brr(y, 3) = arr(y, 5)
        brr(y, 4) = arr(y, 6)
    Next
    GetArrSkud1 = brr
End Function
 
Function GetArrSkud2(sh As Worksheet) As Variant
    Dim arr As Variant
    Dim brr As Variant
    Dim y As Long
    
    With sh
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 7))
    End With
    ReDim brr(1 To UBound(arr, 1), 1 To 4)
    For y = 1 To UBound(arr, 1)
        brr(y, 1) = arr(y, 2)
        brr(y, 2) = arr(y, 1)
        brr(y, 3) = arr(y, 5)
        brr(y, 4) = arr(y, 7)
    Next
    GetArrSkud2 = brr
End Function

Sub GetDic(sh As Worksheet, dicY As Object, dicX As Object)
    With sh
        Dim arr As Variant
        Dim y As Long
         
        y = .Cells(.Rows.Count, 2).End(xlUp).Row
        arr = .Range(.Cells(1, 2), .Cells(y, 2 - (y = 1)))
        Set dicY = CreateObject("Scripting.Dictionary")
        For y = 1 To UBound(arr, 1)
            Select Case arr(y, 1)
            Case "", "ФИО"
            Case Else
                dicY.Item(arr(y, 1)) = y
            End Select
        Next
         
        y = .Cells(2, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(2, 1), .Cells(2 - (y = 1), y))
        Set dicX = CreateObject("Scripting.Dictionary")
        For y = 1 To UBound(arr, 2)
            Select Case arr(1, y)
            Case "", "№ п/п", "ФИО", "Отдел"
            Case Else
                dicX.Item(CStr(arr(1, y))) = y
            End Select
        Next
    End With
End Sub