arr = Range(Cells(1, 1), Cells(10, 10)).Value

    For Each sh In Sheets
        sh.Activate
        ...        'много букв
    Next

Option Base 1

        'определяем последнюю ячейку с данными
        With ActiveSheet.UsedRange: End With
        lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
        lLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
         
        'задаем массив исходных данных
        arr = Range(Cells(1, 1), Cells(lLastRow, lLastCol)).Value

For Each sh In Sheets
    sh.Activate
    arr = Range(Cells(1, 1), Cells(lLastRow, lLastCol)).Value    'как добавить номер листа в эту строку?
Next

'555555
        ActiveSheet.[a1].Resize(.Count, 2).NumberFormat = "General"

'444444
a(i, 2).FormulaLocal = .Item((aK(i - 1)))
'или 
'444444
a(i, 2).FormulaR1C1Local = .Item((aK(i - 1)))

'111111
... _
"=ГИПЕРССЫЛКА(""[" & _
заменить на 
'222222
... _
"=HYPERLINK(""[" & _

'333333 без знака "="
... _
"ГИПЕРССЫЛКА(""[" & _
...
...
...

'777777
'Поиск и замена, добавляем обратно знак =, не работает. Но работает "ручками", а не через макрос.
        Range("B1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Replace What:="ГИПЕРССЫЛКА(""[", Replacement:="=ГИПЕРССЫЛКА(""[" _
        , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat _
        :=False, ReplaceFormat:=False

'555555
        ActiveSheet.[a1].Resize(.Count, 2).NumberFormat = "@"

'666666
        'разбиваем в колонке B:B текст по столбцам, разделитель -- точка с запятой.
        Columns("B:B").Select
        Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
        Columns("B:B").Delete

Sub pr()
    Dim sh As Worksheet, t$
    Dim lLastRow As Long, lLastCol As Long, r As Long, i As Long, j As Long
       
  
    Windows("Скрипт поиска.xlsm").Activate
    
    'альтtрнативный способ задать массив без открытия файла. не подходит для фраз, состоящих более чем из одного слова.
    'a = Split(CreateObject("Scripting.FileSystemObject").Getfile(ActiveWorkbook.Path & "\ИД.txt").OpenasTextStream(1).ReadAll, vbNewLine)
    
    'открываем файл с Исходными Данными
    PathFileTxt = ActiveWorkbook.Path & "\ИД.txt"
    Workbooks.OpenText Filename:=PathFileTxt, Origin:=1251
    Columns("A:A").Select
    
    'разбиваем по столбцам чтобы найти слова, а не фразы
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    
    
    'удаляем пустые строки
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count    'определяем размеры таблицы
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1           'проходим от последней строки до первой
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete   'если в строке пусто - удаляем ее
    Next r
      
    
    'определяем последнюю ячейку с данными
    With ActiveSheet.UsedRange: End With
    lLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    lLastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
    
    'задаем массив исходных данных
    'a = [a1].CurrentRegion.Value       'ограничивает диапазон первой пустой строкой/столбцом, не подходит
    a = Range(Cells(1, 1), Cells(lLastRow, lLastCol)).Value
    ActiveWorkbook.Close False
    
    'создаем словарь с исходными данными для поиска
    With CreateObject("scripting.dictionary")
        For Each el In a
             .Item(el) = ""
        Next
        MsgBox "Список ключей для поиска:" & vbLf & vbLf & Join(.Keys, vbLf)
    'ищем в словаре совпадения на наших листах
        For Each sh In Sheets
            'определяем последнюю ячейку с данными
            With sh.UsedRange: End With
            lLastRow = sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
            lLastCol = sh.UsedRange.Column + sh.UsedRange.Columns.Count - 1
            'задаем массив
            a = sh.Range(sh.Cells(1, 1), sh.Cells(lLastRow, lLastCol)).Value
            'a = [a1].CurrentRegion.Value       'ограничивает диапазон первой пустой строкой/столбцом
            'забиваем словарь адресами ячеек, в которых есть совпадения с ИД
            For i = 1 To UBound(a)
                For j = 1 To UBound(a, 2)
                    t = a(i, j)

'111111 эта строка норм работает
'                   If .exists(t) Then .Item(t) = .Item(t) & IIf(.Item(t) = "", "", ";") & sh.Name & "(" & i & "," & j & ")"

'222222 эта строка НЕ работает, хотя она просто длиннее прошлой, и MsgBox ее отрабатывает так, как и надо в итоге.
'                  MsgBox "=ГИПЕРССЫЛКА(""[" & Application.ActiveWorkbook.FullName & "]" & sh.Name & "!""&АДРЕС(" & i & ";" & j & ");""" & sh.Name & "!""&АДРЕС(" & i & ";" & j & "))"
                  If .exists(t) Then .Item(t) = .Item(t) & IIf(.Item(t) = "", "", ";") & "=ГИПЕРССЫЛКА(""[" & Application.ActiveWorkbook.FullName & "]" & sh.Name & "!""&АДРЕС(" & i & ";" & j & ");""" & sh.Name & "!""&АДРЕС(" & i & ";" & j & "))"
                
                Next
            Next
            
        Next
        
        'создаем новую книгу
        Workbooks.Add
        
        'вытаскиваем из словаря ключи (keys) и их значения (items)
        ActiveSheet.[a1].Resize(.Count, 2) = Application.Transpose(Array(.Keys, .Items))
        
        'разбиваем в колонке B:B текст по столбцам, разделитель -- точка с запятой.
        Columns("B:B").Select
        Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
        Columns("B:XFD").EntireColumn.AutoFit
        Range("A1").Activate
        Application.ScreenUpdating = True
        MsgBox "Done!"
        'ActiveWorkbook.Close False
    End With
 End Sub