Hallo,

dann teste mal:

Public Sub cmd_Simultanität_aus_Click()
Dim rngAuswahl As Range, c As Range
Dim objRangeCollection As Collection

Application.DisplayAlerts = False

Set objRangeCollection = New Collection

'Fehlerbehandlung der Application.Inputbox
'der Code ist von Nepumuk aus dem Office-Forum
Do
    objRangeCollection.Add Application.InputBox(Prompt:= _
    "Bitte die Zelle(n) markieren, deren Simultanität geändert werden soll:", Title:="Auswahl", Type:=8)
    If TypeOf objRangeCollection(objRangeCollection.Count) Is Range Then
        Set rngAuswahl = objRangeCollection(objRangeCollection.Count)
        Exit Do
    ElseIf IsEmpty(objRangeCollection(objRangeCollection.Count)) Then
        MsgBox "Objektzuweisung fehlgeschlagen. Bitte nochmal versuchen", _
        vbCritical, "Fehlermeldung"
    ElseIf Not objRangeCollection(objRangeCollection.Count) Then
        Application.DisplayAlerts = True
        Exit Sub 'Abbrechen geklickt
    Else
        MsgBox "Fehler " & CStr(vbObjectError) & vbLf & vbLf & _
        "Unbekannter Objektfehler beim zuweisen eines Bereiches.", _
        vbCritical, "Fehlermeldung"
        Application.DisplayAlerts = True
        Exit Sub
    End If
Loop
 
If rngAuswahl.Rows.Count > 1 Then
    MsgBox "Bitte wählen Sie nur ein Equipment / eine Anlage aus.", vbCritical
    Exit Sub
End If

For Each c In rngAuswahl.Cells
    If c.Column <= 6 Then
        If IsNumeric(c.Value) And Not IsEmpty(c.Value) Then
            If UCase(Cells(c.Row, 7).Value) <> "X" Then
                MsgBox "Bitte wählen Sie erst die gesamte Zeile simultan.", vbCritical
                Exit Sub
            End If
            If c.Font.ColorIndex <> 16 Then
                c.Font.ColorIndex = 16
                Range("A6").Value = "Gebäude"
            ElseIf c.Font.ColorIndex = 16 Then
                c.Font.ColorIndex = xlAutomatic
                Range("A6").Value = "Gebäude"
            End If
        End If
    ElseIf c.Column = 8 Then
        If IsNumeric(c.Value) And Not IsEmpty(c.Value) Then
            If UCase(Cells(c.Row, 7).Value) <> "X" Then
                MsgBox "Bitte wählen Sie erst die gesamte Zeile simultan.", vbCritical
                Exit Sub
            End If
            If c.Font.ColorIndex <> 16 Then
                c.Resize(1, 3).Font.ColorIndex = 16
                Range("A6").Value = "Gebäude"
            ElseIf c.Font.ColorIndex = 16 Then
                ActiveSheet.Unprotect Password:=""
                c.Resize(1, 3).Font.ColorIndex = xlAutomatic
                Range("A6").Value = "Gebäude"
            End If
        End If
    End If
Next c

Application.DisplayAlerts = True
End Sub

Gruß Werner