Sub ListAllFormulas()'print the formulas in the active workbookDim lRow As LongDim wb As WorkbookDim ws As WorksheetDim wsNew As WorksheetDim c As RangeDim rngF As RangeDim strNew As StringDim strSh As StringOn Error Resume NextApplication.DisplayAlerts = FalseSet wb = ActiveWorkbookstrSh = "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 IfNext wsApplication.DisplayAlerts = TrueEnd Sub
