macros excel

gistfile1.vb

Sub september()
Dim rCell_1 As Range   'первый столбец в первой таблице поиска
Dim rCell_2 As Range    'общий с первым столбец во второй таблице
Dim rCell_3 As Range    'искомый столбец для сопоставления во второй таблице
Dim rCell_4 As Range     'столбец куда нужно вставить результат

Dim intCountWorkboks As Integer 'количество открытых рабочих книг

intCountWorkboks = Application.Workbooks.Count
Set rCell_1 = giveMeRange("Выделите ячейку с заголовком первой таблиц столбца для сопоставления")

Set rCell_2 = giveMeRange("Выделите ячейку с заголовком во второй таблице")
Set rCell_3 = giveMeRange("Выделите  ячейку с заголовком искомого столбца второй таблицы")
Set rCell_4 = Application.InputBox(prompt:="Выделите  ячейку для вставки результирующего столбца", Type:=8)

For i = 2 To rCell_1.Rows.Count
rCell_4.Item(i) = mutchReturnNumberOfRows(rCell_1, rCell_2, rCell_3, i)
Next i
 

End Sub
'=============================================================================================================================
Function giveMeRange(msg As String)
    Dim rCell As Range
    Dim sMsg As String
   

    Set rCell = Application.InputBox(prompt:=msg, Type:=8)
    Set rCell = Range(rCell, rCell.End(xlDown))
    Set giveMeRange = rCell

End Function
'=======================================================================================
Function mutchReturnNumberOfRows(r1 As Range, r2 As Range, r3 As Range, ByVal i As Integer)
 
 mutchReturnNumberOfRows = r3.Item(Application.Match(r1.Item(i), r2, 0))
End Function
'===============================================================================================
Function switchWorkboks()
Dim Wb As Workbook
Dim Wb2 As Workbook
Set Wb = ThisWorkbook
    For Each Wb2 In Application.Workbooks
    Wb2.Activate
    Next
Wb.Activate

End Function

Функция вызывает диалоговое окно с просьбой щелкнуть на названии столбца(String msg), после возвращает объект Range - весь заполненный столбец кроме названия (rCell.Offset(1)).