Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    
    If Target.Value = "Ende" Then Call zeitstrahl_erstellen
    
End Sub
-------------------------------
Sub zeitstrahl_erstellen()
Dim i As Integer
Dim spalte As Long
Dim aktuelle_reihe As Long
Dim zeile As Long

ActiveCell.Select

If ActiveCell.Value = "Ende" Then
        ActiveCell.Select
        With Selection
        spalte = .Column
        zeile = .Row
        End With
        
        For i = 1 To 3000
            aktuelle_reihe = spalte - i
            If ActiveSheet.Cells(zeile, aktuelle_reihe).Value = "Start" Then
                i = 3000
            Else
                ActiveSheet.Cells(zeile, aktuelle_reihe).Interior.ColorIndex = 24
                
            End If
            
        Next i
End If

End Sub

So soll eine Art Zeitstrahl entstehen. An sich funktioniert auch das Zellen-Färben. Allerdings erst, wenn ich in eine Zelle "Ende" schreibe, dann in die Zelle rechts daneben auch "Ende" schreibe und dann das erste "Ende" - sprich das linke - noch einmal mit "Ende" überschreibe. 

Ich verstehe wirklich nicht warum sich das Programm so verhält statt einfach immer wenn ich irgendwo "Ende" reinschreibe mein Sub auszuführen.

Vielen Dank schonmal für eure Hilfe

Liebe Grüße