Sub denn1812()
Dim u(), r&, c&, schet, r1&, sh As Worksheet, re As Object, x, h
u = ActiveSheet.UsedRange.Value
h = "#'" & Replace$(ActiveSheet.Name, "'", "''") & "'!"  'заготовка для гиперссылки
Set sh = Sheets("Плоская табл")
r1 = 3                    'строка, к кот. начинать вывод
schet = u(6, 1)
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.ignorecase = True
re.Pattern = "([a-zа-я]+) Сч. (\d+)"
For r = 7 To UBound(u)                    'цикл по строкам
If Not IsEmpty(u(r, 1)) Then schet = u(r, 1)
For c = 5 To UBound(u, 2)                    'цикл по столбцам
For Each x In re.Execute(u(r, c))
'      sh.Cells(r1, 3) = Cells(r, c).Address(0, 0)       'простой ввод адреса ячейки
sh.Hyperlinks.Add sh.Cells(r1, 3), "", h & Cells(r, c).Address, , Cells(r, c).Address(0, 0)
sh.Cells(r1, 4) = x.submatches(1)
sh.Cells(r1, 5) = x.submatches(0)
sh.Cells(r1, 7) = schet
sh.Cells(r1, 8) = u(4, c)
r1 = r1 + 1
Next
Next
Next
End Sub