KEMBAR78
Sub ListAllFormulas | PDF
Scribd
Upload
16 views1 page

Sub ListAllFormulas

Uploaded by

milad.gholamifar
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
16 views1 page

Sub ListAllFormulas

Uploaded by

milad.gholamifar
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 1

Sub ListAllFormulas()

'print the formulas in the active workbook


Dim lRow As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim c As Range
Dim rngF As Range
Dim strNew As String
Dim strSh As String
On Error Resume Next
Application.DisplayAlerts = False
Set wb = ActiveWorkbook
strSh = "F_"
For Each ws In wb.Worksheets
lRow = 2
If Left(ws.Name, Len(strSh)) <> strSh Then
Set rngF = Nothing
On Error Resume Next
Set rngF = ws.Cells.SpecialCells(xlCellTypeFormulas, 23)
If Not rngF Is Nothing Then
strNew = Left(strSh & ws.Name, 30)
Worksheets(strNew).Delete
Set wsNew = Worksheets.Add
With wsNew
.Name = strNew
.Columns("A:E").NumberFormat = "@" 'text format
.Range(.Cells(1, 1), .Cells(1, 5)).Value _
= Array("ID", "Sheet", "Cell", "Formula", "Formula R1C1")
For Each c In rngF
.Range(.Cells(lRow, 1), .Cells(lRow, 5)).Value _
= Array(lRow - 1, ws.Name, c.Address(0, 0), _
c.Formula, c.FormulaR1C1)
lRow = lRow + 1
Next c
.Rows(1).Font.Bold = True
.Columns("A:E").EntireColumn.AutoFit
End With 'wsNew
Set wsNew = Nothing
End If
End If
Next ws
Application.DisplayAlerts = True
End Sub

You might also like