Guten Tag

Hat jemand eine Idee wie ich folgendes Makros beschleunigen kann:
 

Sub Zeile_Farben_zurücksetzen()

Dim cell As Range
Dim rng As Range
Dim i As String
Dim c As Integer

i = ActiveCell.Row

Dim V_AnzZeilen_1 As Integer
    V_AnzZeilen_1 = ActiveSheet.Range("A65536").End(xlUp).Row ' Spalte A = Referenz
     
If ActiveSheet.Name = "Projektplan" Then

If i >= 18 And i <= V_AnzZeilen_1 Then

Set rng = Range("J" & i & ":IT" & i)

For Each cell In rng.Cells

c = cell.Column
If Cells(17, c).Characters.Font.Color = RGB(255, 0, 0) Then
cell.Interior.Color = RGB(253, 233, 217)
Else
cell.Interior.Color = RGB(242, 242, 242)

End If
Next cell

rng.Select
With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
GoTo Fertig
Else
GoTo Ende2
End If
Else
GoTo Ende1
End If

Ende1:
MsgBox "In diesem Arbeitsblatt darf dieser Befehl nicht ausgeführt werden"
GoTo Fertig

Ende2:
MsgBox "In dieser Zeile darf dieser Befehl nicht ausgeführt werden"
GoTo Fertig

Fertig:

End Sub

Das Makros wird in folgender Tabelle angwendet:

Immer wenn der Tagestext schwarz ist soll die Zellenfarbe grau sein und wenn rot soll die Zellenfarbe Orange sein. Das funktioniert auch wunderbar, aber es geht etwa 5 sek pro Zeile und das ist zu lange um es in diesem Fall sinvoll benutzen zu können. Der Bereich geht mit dem For each Befehl von Spalte J bis Spalte IT und da geht es halt jede Zelle einzeln durch.