Sub AnpassenUVerschieben()

    ' Führt Anpassungen auf den Arbeitsblättern ab dem vierten Blatt durch und verschiebt Daten

    Dim ws As Worksheet ' Deklaration einer Variable vom Typ Worksheet, um auf Arbeitsblätter zuzugreifen
    Dim iSheet As Long ' Deklaration einer Variablen vom Typ Long zur Durchlaufschleifennummerierung
    Dim lastSheet As Long ' Deklaration einer Variablen vom Typ Long zur Speicherung der Anzahl der Arbeitsblätter in der Arbeitsmappe
    Dim voraussetzungPos As Integer ' Deklaration einer Variablen vom Typ Integer zur Speicherung der Position des Worts "Voraussetzung" in Zelle B3
    Dim letzteZeile As Integer ' Deklaration einer Variablen vom Typ Integer zur Speicherung der Zeilennummer der letzten belegten Zelle in Spalte A

    ' Bestimmen der Anzahl der Arbeitsblätter in der aktuellen Arbeitsmappe
    lastSheet = ThisWorkbook.Sheets.Count

    ' Schleife durch jedes Arbeitsblatt ab dem vierten Blatt bis zum letzten Blatt
    For iSheet = 4 To lastSheet
        ' Arbeitsblatt mit der aktuellen Schleifenummer zuweisen
        Set ws = ThisWorkbook.Sheets(iSheet)

        ' Ermitteln der Zeilennummer der letzten belegten Zelle in Spalte A
        letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

        ' Einfügen einer neuen Zeile in Zeile 4 und Kopieren der Formatierung von oben
        ws.Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        ' Setzen des Werts "Voraussetzung" in Zelle A4 des aktuellen Arbeitsblatts
        ws.Range("A4").Value = "Voraussetzung"

        ' Überprüfen, ob das Wort "Voraussetzung" oder "voraussetzung" in Zelle B3 vorhanden ist
        voraussetzungPos = InStr(1, ws.Range("B3").Value, "Voraussetzung", vbTextCompare)
        If voraussetzungPos = 0 Then
            voraussetzungPos = InStr(1, ws.Range("B3").Value, "voraussetzung", vbTextCompare)
        End If

        ' Wenn das Wort gefunden wird
        If voraussetzungPos > 0 Then
            ' Alles nach dem Wort "Voraussetzung" in Zelle B3 in Zelle B4 kopieren
            ws.Range("B4").Value = Mid(ws.Range("B3").Value, voraussetzungPos + Len("Voraussetzung"))

            ' Den kopierten Teil in Zelle B3 löschen
            ws.Range("B3").Value = Left(ws.Range("B3").Value, voraussetzungPos - 1)

            ' Löschen des Wortes "Voraussetzung" in Zelle B3
            ws.Range("B3").Value = Replace(ws.Range("B3").Value, "Voraussetzung", "", , , vbTextCompare)
            ws.Range("B3").Value = Replace(ws.Range("B3").Value, "voraussetzung", "", , , vbTextCompare)
        Else
            ' Wenn das Wort nicht gefunden wird, wird "Keine" in Zelle B4 geschrieben
            ws.Range("B4").Value = "Keine"
        End If
    Next iSheet

    ' Aufrufen einer anderen Prozedur "sucheLoeschen"
    Call sucheLoeschen
    ' Aufrufen einer anderen Prozedur "zumErstenABlatt"

End Sub