Leute! Warum könnt ihr nicht von Anfang an klar sagen, was ihr wollt? Muß man immer wieder nachbessern, weil Ihr Eure Aufgabenstellung nicht durchdenkt oder nicht richtig beschreibt? Das frustriert ungemein, weil man sich vera...t vorkommt, wenn immer wieder "und dann noch, und könnte man nicht noch usw. usw. " nachkommen!

Option Explicit
  
Private Sub Workbook_Open()
Dim lngSpaltenZahl As Long
With ThisWorkbook.Sheets("Tabelle1") 'Hier ggf. den Namen des Tabellenblattes ändern
    For lngSpaltenZahl = 2 To 84
        If Application.WorksheetFunction.Count(.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl))) = 0 Then
            .Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = 3
        Else
            .Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = xlNone
        End If
        If Application.WorksheetFunction.Count(.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl))) = 0 Then
            .Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = 3
        Else
            .Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = xlNone
        End If
    Next lngSpaltenZahl
End With
End Sub
  
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngSpaltenZahl As Long
If Sh.Name <> "Tabelle1" Then Exit Sub 'Hier ggf. den Namen des Tabellenblattes ändern
With Sh
    If Target.Row < 13 Or (Target.Row > 17 And Target.Row < 32) Or Target.Row > 37 Or Target.Column < 2 Or Target.Column > 84 Then Exit Sub
    For lngSpaltenZahl = 2 To 84
        If Application.WorksheetFunction.Count(.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl))) = 0 Then
            .Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = 3
        Else
            .Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = xlNone
        End If
        If Application.WorksheetFunction.Count(.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl))) = 0 Then
            .Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = 3
        Else
            .Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = xlNone
        End If
    Next lngSpaltenZahl
End With
End Sub

Es handelt sich nicht um zwei Lösungsmöglichkeiten! Die eine Prozedur wird beim Öffnen der Datei ausgeführt, damit die Anzeigen korrekt sind. Die andere wird ausgeführt, wenn das Blatt geändert wird. Beide Prozeduren müssen in das Modul "DieseArbeitsmappe" kopiert werden.

Severus