Option Explicit
Sub DocuCells()
     'http://www.mvps.org/dmcritchie/docucells.htm
     'David McRitchie,  Oct 25, 2001
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
     Dim Cell As Range, iRow As Long
     Dim wsNeww As Worksheet, wsCurr As Worksheet
     iRow = 0
     On Error Resume Next   'In case DocuCells sheet not exist
     Application.DisplayAlerts = False
     Worksheets("DocuCells").Delete
     Application.DisplayAlerts = True
     On Error GoTo 0
     Set wsCurr = ActiveSheet
     Worksheets.Add
     ActiveSheet.Name = "DocuCells"
     Set wsNeww = ActiveSheet
     wsCurr.Activate
     On Error Resume Next  'in case no selection with content
     For Each Cell In _
            Intersect(Selection, ActiveSheet.UsedRange)
       If Not IsEmpty(Cell) Then
         iRow = iRow + 1
         wsNeww.Cells(iRow, 1) = Cell.Address(0, 0) & ":   "
         wsNeww.Cells(iRow, 2) = "'" & Cell.Formula
         If Cell.NumberFormat <> "General" Then _
           wsNeww.Cells(iRow, 3) = "     Format: " & Cell.NumberFormat
       End If
     Next
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
     wsNeww.Select
End Sub