Option Explicit
Public Sub ListFormulaErrors()
Dim blnFoundErrors As Boolean
Dim lngRow As Long
Dim rng As Range, rngError As Range
Dim ws As Worksheet, wsTarget As Worksheet
' alle Tabellenblätter der aktiven Mappe durchlaufen
For Each ws In Worksheets
Set rngError = Nothing
' die SpecialCells-Methode liefert einen Laufzeitfehler, wenn keine
' Zellen gefunden werden, die dem Suchkriterium entsprechen
' deshalb wird die Fehlerbehandlung kurzfristig deaktiviert
On Error Resume Next
' fehlerhafte Formeln ermitteln
Set rngError = ws.Cells.SpecialCells( _
Type:=xlCellTypeFormulas, Value:=xlErrors)
' normale Fehlerbehandlung wieder aktivieren
On Error GoTo 0
' Fehler vorhanden?
If (Not rngError Is Nothing) Then
' Ausgabemappe schon erzeugt?
If (Not blnFoundErrors) Then
' nein, dann neu anlegen
Workbooks.Add
blnFoundErrors = True
' Kopfzeile setzen
With Range("A1:C1")
.Value = Array("Blattname", "Zelladresse", "fehlerhafte Formel")
.Font.Bold = True
End With
' Zeilenzähler für Ausgabe initialisieren
lngRow = 2
End If
' alle fehlerhaften Zellen des jeweiligen Blattes durchlaufen
For Each rng In rngError
Cells(lngRow, 1) = ws.Name
Cells(lngRow, 2) = rng.Address
' Prefix-Character voranstellen, dadurch wird die Formel als reiner
' Text interpretiert
Cells(lngRow, 3) = "'" & rng.FormulaLocal
lngRow = lngRow + 1
Next
End If
Next
If (Not blnFoundErrors) Then
MsgBox "Die aktive Mappe enthält keine fehlerhaften Zellen!", vbInformation
Else
' optimale Spaltenbreite einstellen
Columns("A:C").AutoFit
End If
End Sub
Sub alle_Fehler()
Dim wb As Workbook, ws As Worksheet, Zelle As Range
Dim newWb As Workbook, lngCount As Long
Set newWb = Workbooks.Add(1)
For Each wb In Workbooks
For Each ws In wb.Worksheets
For Each Zelle In ws.UsedRange
If Zelle.HasFormula Then
If IsError(Zelle) Then
lngCount = lngCount + 1
With newWb.Sheets(1)
.Cells(lngCount, 1) = wb.Name
.Cells(lngCount, 2) = ws.Name
.Cells(lngCount, 3) = Zelle.Address(0, 0)
.Cells(lngCount, 4) = Zelle
End With
End If
End If
Next
Next
Next
End Sub