Public arr() As Variant
Sub Путь_к_файлу()
    Dim FilesToOpen
    Dim OpenPath As String
    OpenPath = CStr(ThisWorkbook.Path)
    'ChDrive "C:\Program Files"
    'ChDrive OpenPath
    'ChDir OpenPath
    FilesToOpen = Application.GetOpenFilename _
        ("Excel files(*.xls*),*.xls*", 1, "Выбрать файл", , False)
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Файл не выбран!"
        Exit Sub
    End If
    Cells(2, "F") = FilesToOpen
End Sub
Sub Открытие_файла()
    Application.ScreenUpdating = False
    Set importWb = Workbooks.Open(Cells(2, "F"))
    For Each ws In importWb.Sheets
    With ws
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A2:D" & lr).Copy
        cr = ThisWorkbook.Sheets("Source").Cells(ThisWorkbook.Sheets("Source").Rows.Count, "A").End(xlUp).Row + 1
        ThisWorkbook.Sheets("Source").Range("A" & cr).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ThisWorkbook.Sheets("Source").Range("E" & CStr(cr) & ":E" & cr + lr - 1).Value = ws.Name
    End With
    Next
    Application.CutCopyMode = False
    importWb.Close False
    With Sheets("Source")
        arr = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
    Sheets("Коэффициенты").Select
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Count <> 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        If Target.Column = 2 Then
            tra = Target.Value
            trp = Target.Offset(, -1).Value
            For i = 1 To UBound(arr)
                If trp = arr(i, 5) Then
                    If tra = arr(i, 1) Then
                        Target.Offset(, 1).Value = arr(i, 2)
                        Target.Offset(, 3).Value = arr(i, 3)
                        Target.Offset(, 4).Value = arr(i, 4)
                    End If
                End If
            Next
        End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub