Reihen markieren

Sub Markierung()
'
'
' Tastenkombination: Strg+e
'
Dim i As Long
Dim Bereich As String
On Error GoTo errorhandler

For i = 1 To Range("A65536").End(xlUp).Row

If Cells(i, 1).Interior.ColorIndex = 6 Then

If Bereich = "" Then
Bereich = Range(Cells(i, 1), Cells(i, 256)).Address
Else
Bereich = Bereich & "," & Range(Cells(i, 1), Cells(i, 256)).Address
End If

End If

Next i

Range(Bereich).Select

Exit Sub
errorhandler:
MsgBox "Es existieren keine roten Felder (ColorIndex 3) in Spalte A."
End Sub

Danke
Max