Hello Tom,

Thank you very much for your Help!!!
I now solved the problem this way...

Regards,
wullux

Sub Auswertung()
Dim rng As String
Dim ws As Worksheet
Dim j As Integer
Dim wert As Integer
Dim z As Integer
Dim lngletztezeile As Integer
Dim ol As OLEObject
Dim s As String
For j = 1 To Worksheets.Count
For Each ol In Worksheets(j).OLEObjects
Application.EnableEvents = False
rng = ol.TopLeftCell.Address
s = Mid(rng, 2, InStr(2, rng, "$") - 2)
z = Right(rng, Len(rng) - InStr(2, rng, "$"))
If ol.Object.Value = True Then
If Worksheets(j).Cells(z, 1).Value = "Ausgefallen" Then
Tabelle1.Cells(j, Columns(s).column).Interior.ColorIndex = 3
GoTo nextol
End If
wert = Tabelle1.Cells(j, Columns(s).column).Value
wert = wert + 1
Tabelle1.Cells(j, Columns(s).column).Value = wert
End If
nextol:
Next ol
Application.EnableEvents = True
On Error GoTo 1
Tabelle1.Cells(j, 33) = WorksheetFunction.Sum(Cells(j, 2), Cells(j
3))
1:
Next j
Exit Sub
End Su

--
Message posted from http://www.ExcelForum.com