Option Explicit
Sub test()
Dim ws As Worksheet, c As Range, i As Integer
Worksheets.Add
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then
For Each c In ws.UsedRange
If Not ActiveWorkbook.Styles(c.Style.Name).BuiltIn Then
i = i + 1
Cells(i, 1) = c.Address(external:=True)
Cells(i, 2) = c.Style.Name
End If
Next c
End If
Next ws
End Sub