Danke erstmal für die antwort, aber das mit der Forschleife habe ich schon probiert und es kommt wieder zu einer endlos schleife.

Ich bin eigentlich erfahren im Schleifen programmieren, bin nur neu im VBA unterwegs.

an bei mal noch mein ganzer code

Option Explicit

Private Sub WorkSheet_Change(ByVal Target As Range)
  
    Call Montagevorspannkraft
'    Call Farbabfrage_Flaechenpressung
    'Call Farbabfrage_Schraubenauslastung
    
End Sub

Sub Montagevorspannkraft()
Dim Abschnitt, S, N, M, Zeile, Spalte, Zeile2, Spalte2 As Integer
    Abschnitt = 0
    S = 1
        Do
            Zeile = S + Abschnitt
            Zeile2 = S + 1 + Abschnitt
                If Cells(Zeile, 16) = "" Then
                    Cells(Zeile, 17) = ""
                    Else
                    Cells(Zeile, 17) = Cells(Zeile, 16) + Cells(Zeile2, 16)
                End If
            Abschnitt = Abschnitt + 13
            S = S + 1
       Loop Until S > 3
    Cells(1, 15) = S
End Sub

Sub Farbabfrage_Flaechenpressung()
Dim S, N, M, Zeile, Spalte, Zeile2, Spalte2 As Integer

  For S = 0 To 26 Step 13

    For N = 1 To 3 Step 2
    Zeile = S + N
    Zeile2 = Zeile + 1
  
     For M = 1 To 5 Step 2
     Spalte = 0 + M
     Spalte2 = Spalte + 1
   
      Select Case Cells(Zeile, Spalte)
       Case Is = ""
         ' Grau
         With Sheets("Tabelle1")
         .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 15
         End With
       Case Is <= Cells(S + 1, 8)
         'Gruen
         With Sheets("Tabelle1")
          .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 43
         End With
       Case Is > Cells(S + 1, 8)
         ' Rot
         With Sheets("Tabelle1")
          .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 3
         End With
      End Select
    
     Next M
   
   Next N
   
  Next S
  
End Sub

Sub Farbabfrage_Schraubenauslastung()
Dim S, N, M, Zeile, Spalte, Zeile2, Spalte2 As Integer

  For S = 0 To 26 Step 13
  
  For N = 1 To 3 Step 2
  Zeile = S + N
  Zeile2 = Zeile + 1
  
   For M = 1 To 5 Step 2
   Spalte = 8 + M
   Spalte2 = Spalte + 1
   
    Select Case Cells(Zeile, Spalte)
     Case Is = ""
       ' Grau
       With Sheets("Tabelle1")
         .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 15
       End With
     Case 85 To 92
       'Gruen
       With Sheets("Tabelle1")
        .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 43
       End With
     Case Is > 92
       ' Rot
       With Sheets("Tabelle1")
        .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 3
       End With
     Case Is > 0 And Cells(Spalte, Zeile) < 85
       ' Orange
       With Sheets("Tabelle1")
         .Range(Cells(Zeile, Spalte), Cells(Zeile2, Spalte2)).Interior.ColorIndex = 46
       End With
    End Select
    
   Next M
   
 Next N
 
 Next S
  
End Sub

Die Schleifen in meinen zwei anderen sub strukturen laufen ohne probleme, irgendwie muss es an meiner if abfrage glaube ich liegen! er spring immer wieder zu der end if anweisung in der ersten sub struktur nachdem er alles durchlaufen hat!