Option Explicit
 
 
 
	Sub ListOfAllFormulas()
 
 
 
	'*************************************
 
	'**** Code from VisibleVisual.com ****
 
	'*************************************
 
 
 
	Dim wrkSht As Worksheet
 
	Dim wrkShtName
 
	Dim myRng As Range
 
	Dim newRng As Range
 
	Dim c As Range
 
 
 
	wrkShtName = "Formulas"
 
 
 
	On Error Resume Next
 
	Set wrkSht = Sheets(wrkShtName)
 
	If Not wrkSht Is Nothing Then
 
	MsgBox "This sheet already exists"
 
	Err.Clear
 
	Set wrkSht = Nothing
 
	Exit Sub
 
	End If
 
 
 
	Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
 
 
 
	Application.ScreenUpdating = False
 
	With ActiveSheet '
 
	.Range("A1").Value = "Formula"
 
	.Range("B1").Value = "Sheet Name" '
 
	.Range("C1").Value = "Cell Address"
 
	.Name = wrkShtNamex
 
	End With
 
 
 
	For Each wrkSht In ActiveWorkbook.Worksheets
 
	If wrkSht.Name <> wrkShtName Then
 
	Set myRng = wrkSht.UsedRange
 
	On Error Resume Next
 
	Set newRng = myRng.SpecialCells(xlCellTypeFormulas)
 
	For Each c In newRng '
 
	Sheets(wrkShtName).Range("A65536").End(xlUp).Offset(1, 0).Value = Mid(c.Formula, 2, (Len(c.Formula)))
 
	Sheets(wrkShtName).Range("B65536").End(xlUp).Offset(1, 0).Value = wrkSht.Name
 
	Sheets(wrkShtName).Range("C65536").End(xlUp).Offset(1, 0).Value = Application.WorksheetFunction.Substitute(c.Address, "$", "")
 
	Next c
 
	End If
 
	Next wrkSht
 
	Sheets(wrkShtName).Activate
 
	ActiveSheet.Columns("A:C").AutoFit
 
	Application.ScreenUpdating = True
 
	End Sub