[a_axe]

Оффтоп

когда работа будет например с 1,5 млн строк в которых примерно 40 столбцов, тогда перебор увы не покатит. »

Разумеется - сделать указанную рабочую книгу просто-напросто не получится, смотрите тут. Если подобрать грамотный алгоритм, будет совершенно без разницы 40 у вас колонок или 2000.

А так спасибо за лестные слова »

blackeangel, вы вполне определенно описали в первых постах проблему, приложили вполне определенные примеры, вам дали два решения. После этого оказалось, что условия совсем другие, примеры тоже не полностью отражают реальность. Потраченное на ваши проблемы время ушло в пустую только по той причине, что вам было лень грамотно расписать условия задачи (даже если ее вам поставил кто-то другой). Появится новый вариант решения - у вас вероятно появится еще одно условие, о котором ну прямо никак нельзя было сказать заранее.

Сейчас в меня полетят какашки по поводу что тут надо »

Извините - сильно комментировать не стану, только в части того, что смысл форума во многом в этом и заключается, указывать свое виденье что и каким образом лучше делать в той или иной ситуации. Слушать или нет - дело абсолютно добровольное.

В мое советское школьное детство преподаватели вбили одну незатейливую истину: правильно и грамотно оформленные условия задачи являются ровно половиной ее решения.
Что нужно делать у вас - извините, абсолютно для меня не понятно.

Ах да, и как оказалось, столбцов из базы(2 файл) надо брать 3... »

Просто здорово, что вы не указываете, какие именно столбцы и в каком порядке. Тут все просто обожают угадывать.

И располагаются они хаотично.. »

Это следует показать в примере, если необходимо - в нескольких.

учитывает только первую входимость, а надо все... »

Что такое первая входимость? Как ее нужно учитывать - записывать одинаковые строчки, или есть некий алгоритм как их различать?

Необходимо к перечню 1го файла прикрутить тот столбец что во втором файле, »

Как следует понимать слово "прикрутить"?
Еще раз терпеливо вам объясняю: отсутствие внятной постановки задачи с большой долей вероятности делает невозможным ее решение. Опишите хотя бы Ваше виденье алгоритма: "обработчик в исходном файле ищет ячейку с содержимым "Инструм.", получает номер столбца, перебирает в нем все непустые ячейки, ищет значение каждой из этих ячеек во втором файле, если нашел - копирует значения из столбцов с заголовками такими-то..." и т.д. Вы это формулируете в виде "нужно прикрутить", а что конкретно делать нужно - в общем-то не понятно.
Привожу свое интуитивное виденье кода, который вероятно вам нужен. Если вы его просто проигнорируете - как первый код, будто его и не было - возьму самоотвод от участия в этой теме. Запускать код нужно при активном документе, куда вы хотите копировать данные. Открыты д.б. оба документа.

код

Код:

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
    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