Sub FindFormatting()
Dim MyCell As Range
Dim strCellList, strFontName, strLastCell _
As String
Dim strUsedRange, strCellStyle As String
Dim intSize, intColorIndex, intFillColor _
As Integer
Dim blnTest, blnBold, blnItalic As Boolean

With ActiveCell.Font

  strFontName = .Name
  intSize = .Size
  intColorIndex = .ColorIndex
  blnBold = .Bold
  blnItalic = .Italic
End With

intFillColor = ActiveCell.Interior.ColorIndex

  With ActiveSheet.Cells
    strLastCell = _
    .SpecialCells(xlCellTypeLastCell).Address
  End With

  strCellList = ActiveCell.Address
  strUsedRange = "$A$1:" & strLastCell

For Each MyCell In Range(strUsedRange).Cells
blnTest = False
 If MyCell.Font.Name = strFontName Then
  If MyCell.Font.Bold = blnBold Then
   If MyCell.Font.Italic = blnItalic Then
    If MyCell.Font.ColorIndex = intColorIndex Then
     If MyCell.Font.Size = intSize Then
      If MyCell.Interior.ColorIndex = intFillColor Then
       blnTest = True
      End If
     End If
    End If
   End If
  End If
 End If

If blnTest = True Then 
  strCellList = strCellList & ", " & _
  MyCell.Address
End If

Next MyCell

On Error Resume Next
Range(strCellList).Select

If Err Then MsgBox ("Konnte Zellen nicht auswählen. " & _
  "Eventuell gibt es zu viele Zellen " _
  & "mit diesem Format.")
End Sub