Hallo Gast25455,

schon mal Danke für den Code und deine Hilfe. Dachte man läd sich die Tabelle+Code von der verlinkten Seite.

Habe einen ganz anderen Ansatz gewählt.

Im letzen Teil des Codes steht die Anweisung.

'Globale Variablen
Public datumB1 As Variant
Public zellenB4B10 As Variant
Public istSchaltjahr As Boolean

Private Sub Workbook_Open()
    ' Variablen deklarieren
    Dim ws As Worksheet
    Dim wsDeckblatt As Worksheet
    Dim wsStudien As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim i As Integer
    
    ' Variablen iterieren
    Set ws = ThisWorkbook.Sheets("Deckblatt")
    Set wsDeckblatt = ThisWorkbook.Sheets("Deckblatt")
    Set wsStudien = ThisWorkbook.Sheets("Studien")
    Set rng = ws.Range("B4:B10")
    
    ' Prüfen, ob Zelle B1 leer ist und ob alle Zellen B4, B5, B6, B7, B8, B9, B10 leer sind
    If IsEmpty(ws.Range("B1").Value) And _
       IsEmpty(ws.Range("B4").Value) And _
       IsEmpty(ws.Range("B5").Value) And _
       IsEmpty(ws.Range("B6").Value) And _
       IsEmpty(ws.Range("B7").Value) And _
       IsEmpty(ws.Range("B8").Value) And _
       IsEmpty(ws.Range("B9").Value) And _
       IsEmpty(ws.Range("B10").Value) Then
        MsgBox "Bitte tragen Sie ein Datum in Zelle B1 und die Namen der Studie ein. Speichern Sie die Änderung. Schließen Sie die Arbeitsmappe und öffnen Sie die Arbeitsmappe wieder, damit die Änderungen übernommen werden."
    End If
    
    ' Prüfen, ob in Zelle B1 eine Zahl steht
    If IsNumeric(ws.Range("B1").Value) Then
        ' Jahr gefunden, Ergebnis in globaler Variable und Zelle C1 speichern
        datumB1 = CInt(ws.Range("B1").Value)
        ws.Range("C1").Value = datumB1
        
        ' Prüfen, ob das Jahr ein Schaltjahr ist
        istSchaltjahr = False
        If (datumB1 Mod 4 = 0 And datumB1 Mod 100 <> 0) Or datumB1 Mod 400 = 0 Then
            istSchaltjahr = True
        End If
        ws.Range("E1").Value = istSchaltjahr
    End If
    
   ' Prüfen, ob in den Zellen B4:B10 etwas eingetragen ist
    For Each cell In rng
        i = cell.Row - 3
        On Error Resume Next ' Falls das Arbeitsblatt nicht existiert, wird der Fehler ignoriert
        If Not IsEmpty(cell.Value) Then
            ' Inhalt gefunden, Ergebnis in globaler Variable und Zelle D1 speichern
            zellenB4B10 = zellenB4B10 & " " & cell.Address
            ws.Range("D1").Value = zellenB4B10
            ' Das entsprechende Arbeitsblatt einblenden
            ThisWorkbook.Sheets("Studie_" & i).Visible = True
        Else
            ' Wenn die Zelle leer ist, das entsprechende Arbeitsblatt ausblenden
            ThisWorkbook.Sheets("Studie_" & i).Visible = False
        End If
        On Error GoTo 0 ' Fehlerbehandlung zurücksetzen
    Next cell
    
   
Set wsStudien = ThisWorkbook.Sheets("Studien")

' Wert aus Zelle D1 holen
zellenB4B10 = wsDeckblatt.Range("D1").Value

' Überprüfen, ob der Wert leer ist
If IsEmpty(zellenB4B10) Then
    ' Zeilen im Worksheets "Studien" ausblenden
    For i = 1 To 7
        wsStudien.Rows(i + 7).EntireRow.Hidden = True
    Next i
Else
    ' Zeilen im Worksheet "Studien" einblenden
    Dim zellen As Variant
    zellen = Split(zellenB4B10, " ")
    For Each zelle In zellen
        If zelle <> "" Then
            i = Right(zelle, 1) - 3
            wsStudien.Rows(i + 7).EntireRow.Hidden = False
        End If
    Next zelle
  End If
End Sub