Sub IdentifyConst()
Dim cell As Range, rng As Range
Dim regex
Dim i As Long
Dim wsNew As Worksheet
Dim xlCalc As XlCalculation
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set wsNew = Worksheets.Add(before:=Sheets(1))
wsNew.Range("A1:B1").Value = Array("Cell", "Formula")
Set regex = CreateObject("vbscript.regexp")
For i = 2 To Worksheets.Count
On Error Resume Next
Set rng = Worksheets(i).UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
With regex
.Pattern = "([\+\-\*\/]\d+\b)|(\=\d+\b)"
For Each cell In rng
If .test(cell.Formula) Then
With wsNew
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Formula = "=HYPERLINK(""#'"" & """ & Worksheets(i).Name & _
"'!" & cell.Address & """,""'" & Worksheets(i).Name & "'!" & cell.Address & """)"
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).Value = "'" & cell.Formula
End With
End If
Next cell
End With
Set rng = Nothing
End If
Next i
With Application
.Calculation = xlCalc
.EnableEvents = True
End With
End Sub