Sub makeLinks()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, contentWs As Worksheet, curPos As Range, ccol As Range, rrow As Range
    ' Лист с оглавлением
    Set contentWs = ActiveWorkbook.Sheets("Оглавление")
    ' Очистим содержимое после шапки
    Range(contentWs.Range("A3"), contentWs.UsedRange.SpecialCells(xlCellTypeLastCell)).Value = ""
    ' Удалим существующие на листе ссылки
    contentWs.Hyperlinks.Delete
    
    ' Пройдемся циклом по всем листам
    For Each ws In ActiveWorkbook.Sheets
        ' Нас интересуют все листы кроме листа оглавления
        If ws.Name <> contentWs.Name Then
            
            ' На листе ищем значения
            ' Столбец = "зарегистр."
            ' Строка = "Итого:"
            Set ccol = ws.Cells.Find(What:="зарегистр.", LookAt:=xlWhole)
            Set rrow = ws.Cells.Find(What:="Итого:", LookAt:=xlWhole)
            ' Если оба значения есть на листе - значит на их пересечении нужное значение, добавим ссылку и значение в оглавление
            If Not ccol Is Nothing And Not rrow Is Nothing Then
                ' Первый пустая строка в оглавлении
                Set curPos = contentWs.Cells(contentWs.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)
                ' Столбец A = Ссылка на первую ячейку просматриваемого листа, оттуда же текст ссылки
                contentWs.Hyperlinks.Add Anchor:=curPos, Address:=addrTxt, TextToDisplay:=ws.Range("A1").Value
                ' Столбец B = Значение на пересечении "зарегистр." и "Итого:" просматриваемого листа
                curPos.Offset(0, 1).Formula = "=" & Intersect(ccol.EntireColumn, rrow.EntireRow).Address(True, True, xlA1, True)
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Function Количество_зарег(ByVal rCell As Range) As Double
    Dim s As String
    If rCell.Hyperlinks.Count <> 0 Then
      s = Mid(rCell.Hyperlinks(1).SubAddress, 2, InStr(1, rCell.Hyperlinks(1).SubAddress, "!") - 3)
        If s <> "" Then
           Set FR = Sheets(s).Cells.Find("Итого:")
           If Not FR Is Nothing Then Количество_зарег = FR.Offset(, 4).Value
        End If
    End If
End Function