Sub макрос ()
Dim iFoundRng As Range, iRow As Long
Dim iDataWb As Workbook, TmpWb As Workbook, FoundFlag As Boolean
Dim MsgResult As VbMsgBoxResult, iTempSht As Worksheet, iListSht As Worksheet

Application.ScreenUpdating = False

For Each TmpWb In Workbooks
If Not TmpWb.Name = ThisWorkbook.Name And TmpWb.Name <> "PERSONAL.XLS" Then
MsgResult = MsgBox(TmpWb.Name, vbYesNoCancel + vbDefaultButton2 + vbQuestion, "Text*")
If MsgResult = vbCancel Then Exit Sub
If MsgResult = vbYes Then
Set iDataWb = Workbooks(TmpWb.Name)
Exit For
End If
End If
Next TmpWb
Set TmpWb = Nothing
Set iListSht = ThisWorkbook.Worksheets("Лист1")

FoundFlag = False
With iListSht
For iRow = [b]9[/b] To .Range("[b]J9[/b]").End(xlDown).Row

For Each iTempSht In iDataWb.Worksheets
Set iFoundRng = iTempSht.Range("[b]J:J[/b]").Find(iListSht.Cells(iRow, "[b]G[/b]"), , xlFormulas, xlWhole)

If Not iFoundRng Is Nothing Then
FoundFlag = True
.Cells(iRow, "[b]K[/b]") = iTempSht.Cells(iFoundRng.Row, "[b]AQ[/b]")
.Cells(iRow, "[b]L[/b]") = iTempSht.Cells(iFoundRng.Row, "[b]AI[/b]")

End If
Next iTempSht
If FoundFlag = False Then iListSht.Cells(iRow, "[b]K[/b]") = "No"

FoundFlag = False
Next iRow
End With

Application.ScreenUpdating = True

'MsgBox "Stop", vbInformation, "Stop"

End Sub