Прикрутить столбец из другой файла с условием

Sub an()
Workbooks("2.xlsx").Worksheets(1).Range("A2:a" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Workbooks("1.xlsm").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
 
Columns("A:A").Select
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
    End Sub

Workbooks("2.xlsx").Worksheets(1).Range("A2:a" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Workbooks("1.xlsm").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)

   Sub PrikList()
    Dim i As Integer
Dim j As Integer
Dim lLR As Integer
    Workbooks("2.xlsx").Worksheets(1).Copy after:=Workbooks("1.xlsm"). _
    Sheets(1)
   ThisWorkbook.Worksheets(2).Range("A2:a" & Cells(Rows.Count, 1).End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
Columns("A:A").Select
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
i = 2
lLR = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(1).Select
    Do While Worksheets(1).Cells(i, 1).Value <> Empty
  For j = 2 To lLR 
 If Worksheets(1).Cells(i, 1).Value Like Worksheets(2).Cells(j, 1).Value Then
    Worksheets(1).Cells(i, 4).Value = Worksheets(2).Cells(j, 4).Value
   End If
  Next j
i = i + 1
  Loop
  Application.DisplayAlerts = False
  Sheets(2).Delete
 Application.DisplayAlerts = True
    End Sub

Sub osnastka()
Application.ScreenUpdating = False
i = 2
' работаем с активной книгой
sWhatFind2 = "Обозначение"
Cells.Find(What:=sWhatFind2, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn2 = ActiveCell.Column ' нашли столбец с обозначением
Columns(ncolumn2 + 1).Insert 'вставляем столбец справа
Cells(1, ncolumn2 + 1).Value = "Инструм." 'вставляем заголовок столбца
' работаем с "базой"
sWhatFind = "№ детали"
sWhatFind3 = "Инструм."
n = ThisWorkbook.Path & "" & "Оснастка.xlsx"
Set s = GetObject(n)
Set ndetali = s.Worksheets(1).Cells.Find(What:=sWhatFind, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
k = ndetali.Column
Set ninstrum = s.Worksheets(1).Cells.Find(What:=sWhatFind3, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
l = ninstrum.Column
MsgBox "cell= " & Cells(i, k).Value
'цикл
Do While Cells(i, ncolumn2).Value <> Empty 'поставил на "Обозначение" т.к. обрывался на пустой ячейке
If Cells(i, k).Value Like Cells(i, ncolumn2).Value Then
Cells(i, ncolumn2 + 1).Value = s.Worksheets(1).Cells(i.Row, l)
End If
i = i + 1
Loop
s.Close SaveChanges:=False 'закрываем файл без сохранения
End Sub