Seiten erkennen

Sub ErkenneBeschriebeneBlaetter()

    Dim ws As Worksheet

    Dim isWritten As Boolean

    Dim checkCell As Range

    Dim rowNum As Long

    Dim sheetName As String

    Dim outputWs



    ' Erstelle ein neues Blatt für die Ausgabe

  ''  Set outputWs = ThisWorkbook.Sheets.Add

  ' ' outputWs.Name = "Beschriebene Blätter"

    

    ' Setze die Startzeile für die Ausgabe

   ' rowNum = 1

   ' outputWs.Cells(rowNum, 1).value = "Beschriebene Blätter:"

   ' rowNum = rowNum + 1



    ' Iteriere durch alle Blätter der Arbeitsmappe

    For Each ws In ThisWorkbook.Worksheets

        ' Bestimme die zu prüfende Zelle je nach Blattname

        Select Case ws.Name

            Case "Seite 2"

                Set checkCell = ws.Range("B91")

                ActiveSheet.Range("B67:E129").Select

            

            Case "Seite 3"

                Set checkCell = ws.Range("B155")

                ActiveSheet.Range("B131:E193").Select

            

            Case "Seite 4"

                Set checkCell = ws.Range("B219")

                ActiveSheet.Range("B195:E256").Select

                

            Case "Seite 5"

                Set checkCell = ws.Range("B282")

                ActiveSheet.Range("B258:E319").Select

                

            Case "Seite 6"

                Set checkCell = ws.Range("B346")

                ActiveSheet.Range("A321:E383").Select

            Case Else

                Set checkCell = Nothing ' Blätter, die nicht "Seite 2" bis "Seite 6" sind, überspringen

        End Select

        ' Überprüfe, ob die Zelle beschrieben ist

        If Not checkCell Is Nothing Then

            If Not IsEmpty(checkCell.value) Then

                ' Wenn Zelle beschrieben ist, trage den Blattnamen in das neue Blatt ein

               ' outputWs.Cells(rowNum, 1).value = ws.Name

                rowNum = rowNum + 1

            End If

        End If

    Next ws

End Sub