[a_axe]

Итак, по коду - постоянно ругается что не открыты 2 файла, хотя открыты оба и кроме их больше ничего. »

попробуйте запустить вариант кода ниже, он перечислит по очереди все открытые файлы в сообщении.

код с проверкой

Код:

Public Sub osn()
    Dim dataBook As Workbook
    Dim dataSheet As Worksheet
    Dim myCell As Range
    Dim i As Long, j As Long, k As Long, m As Long, n As Long, Ik As Integer
    For Each dataBook In Application.Workbooks
        Ik = Ik + 1
        MsgBox "Открыто " & Application.Workbooks.Count & " рабочих книг, №" & Ik & " - " & dataBook.Name
    Next
    If Application.Workbooks.Count = 2 Then
        For Each dataBook In Application.Workbooks
            If dataBook.Name <> ThisWorkbook.Name Then Set dataSheet = dataBook.ActiveSheet
            
        Next
        i = dataSheet.Rows(1).Find(What:="№ детали", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
        j = dataSheet.Rows(1).Find(What:="Инструм.", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
        k = dataSheet.Rows(1).Find(What:="Год", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
        m = ActiveSheet.Rows(1).Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows).Column
        Debug.Print dataSheet.Name
        Debug.Print i & " " & j & " " & k & " " & m
        For Each myCell In Intersect(ActiveWorkbook.ActiveSheet.UsedRange, ActiveWorkbook.ActiveSheet.Columns(m))
            On Error Resume Next
            Err.Clear
            n = Application.WorksheetFunction.Match(myCell.Value, Range(dataSheet.Cells(1, i), dataSheet.Cells(dataSheet.UsedRange.Count, i)), 0)
            myCell.Offset(0, 1).Value = Application.WorksheetFunction.Index(Range(dataSheet.Cells(1, j), dataSheet.Cells(dataSheet.UsedRange.Count, j)), n)
            myCell.Offset(0, 2).Value = Application.WorksheetFunction.Index(Range(dataSheet.Cells(1, k), dataSheet.Cells(dataSheet.UsedRange.Count, k)), n)
            
            If Err.Number <> 0 Then
                myCell.Offset(0, 1).Value = ""
                myCell.Offset(0, 2).Value = ""
            End If
            
        Next
        ActiveWorkbook.ActiveSheet.Cells(1, m).Value = "Обозначение"
    Else
        MsgBox "Должно быть открыто 2 файла."
    End If
    Set dataSheet = Nothing
End Sub

Отпишитесь по результату, сколько он показывает файлов. Либо можно определить имя файла, из которого будет выполняться копирование.