функцией внести данные

Sub FindMatchInBackground() 'короткое приоткрытие
 
    ' Определить пути к файлам
    Dim relativesPath As String
    Dim problemPath As String
    relativesPath = ThisWorkbook.Path & "\родственники.xlsm"
    problemPath = ThisWorkbook.Path & "\проблема.xlsm"
 
    ' Открыть файл "проблема.xlsm"
    Dim problemWorkbook As Workbook
    Set problemWorkbook = Workbooks.Open(problemPath)
 
    ' Получить листы и именованные диапазоны (если используются)
    Dim problemWorksheet As Worksheet
    Dim searchValue As String
    Set problemWorksheet = problemWorkbook.Worksheets("Лицо")
    searchValue = problemWorksheet.Range("K16").Value ' Или используйте именованный диапазон
 
    ' Запустить фоновый поиск
    Dim backgroundWorkbook As Workbook
    Set backgroundWorkbook = Workbooks.Open(relativesPath)
    Dim backgroundWorksheet As Worksheet
    Set backgroundWorksheet = backgroundWorkbook.Worksheets("Лист1")
    Dim backgroundFindCell As Range
    Set backgroundFindCell = backgroundWorksheet.Rows(1).Find(searchValue, LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
 
    ' Проверка на наличие совпадения (отображается после завершения фонового поиска)
    If Not backgroundFindCell Is Nothing Then
        MsgBox "совпадение найдено в ячейке: " & backgroundFindCell.Address
    Else
        MsgBox "Совпадение не найдено."
    End If
 ' Закрыть файл "родственники.xlsm"
    backgroundWorkbook.Close SaveChanges:=False
    ' Закрыть файл "проблема.xlsm"
    problemWorkbook.Quit SaveChanges:=False
 
End Sub