Макрос для переноса данных из одного документа Excel в другой

Option Explicit  
   
Const SKUD_XLSX = "Отчет1.xls"  
Const TABL_XLSX = "Учет рабочего времени.xlsx"  
   
Sub СКУДвТабель()  
    Dim wbS As Workbook  
    Dim wbT As Workbook  
    On Error Resume Next  
    Set wbS = Workbooks("Отчет1.xls")  
    Set wbT = Workbooks("Учет рабочего времени.xlsx")  
    On Error GoTo 0  
    If wbS Is Nothing Then  
        MsgBox "Не найден файл " & SKUD_XLSX, vbInformation  
    Else  
        If wbT Is Nothing Then  
            MsgBox "Не найден файл " & TABL_XLSX, vbInformation  
        Else  
            Dim arrSkud As Variant  
            arrSkud = GetArrSkud(wbS.Sheets(1))  
               
            Dim dicY As Object  
            Dim dicX As Object  
            GetDic wbT.Sheets(1), dicY, dicX  
               
            PrintResult wbT.Sheets(1), wbS.Sheets(1), arrSkud, dicY, dicX  
        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(arrSkud(ySkud, 2)) Then  
                        rep(ySkud, 1) = "+"  
                        y = dicY.Item(arrSkud(ySkud, 1))  
                        x = dicX.Item(arrSkud(ySkud, 2))  
                        For i = 0 To 1  
                            If arrSkud(ySkud, 5 + i) <> "" Then  
                                .Cells(y, x + i).Value = arrSkud(ySkud, 5 + 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 GetArrSkud(sh As Worksheet)  
    With sh  
        Dim arr As Variant  
        Dim y As Long  
        y = .Cells(.Rows.Count, 3).End(xlUp).Row  
        GetArrSkud = .Range(.Cells(1, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 8))  
    End With  
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