Hi Moritz,

Probiers mal so:

Sub ErsetzeAbschnitt()
    Dim userInput As String
    Dim doc As Document
    Dim range As range
    Dim startRange As range
    Dim endRange As range
    Dim foundSection As Boolean
    Dim stl As Style
    
    ' Benutzereingabe abfragen
    userInput = InputBox("Geben Sie den Abschnitt ein, der ersetzt werden soll:", "Abschnitt ersetzen")
    
    ' Dokument und Range initialisieren
    Set doc = ActiveDocument
    Set range = doc.Content
    foundSection = False
    
    ' Schleife über alle Absätze im Dokument
    For Each para In doc.Paragraphs
        ' Überprüfen, ob der Absatz eine spezielle Nummerierungsfunktion hat
        If para.range.ListFormat.ListType <> wdListNoNumbering Then
            ' Überprüfen, ob der Absatz mit dem eingegebenen Text beginnt
            If Left(para.range.ListFormat.ListString, Len(userInput)) = userInput Then
                ' Bereich des Abschnitts festlegen
                If Not foundSection Then
                    Set startRange = para.range
                    foundSection = True
                    Set stl = startRange.Style
                End If
            ElseIf foundSection Then
                ' Den nächsten Absatz mit gültiger Nummerierung finden
                Set endRange = para.range
                If endRange.Style = startRange.Style Then Exit For
            End If
        ElseIf foundSection Then
            ' Absatz durchsuchen, um untergeordnete Nummerierungen zu erfassen
            For Each subPara In para.range.Paragraphs
                If subPara.range.ListFormat.ListType <> wdListNoNumbering Then
                    Set endRange = subPara.range
                    Exit For
                End If
            Next subPara
            
            If endRange Is Nothing Then
                ' Kein weiterer Absatz mit gültiger Nummerierung gefunden
                Set endRange = para.range
                Exit For
            End If
        End If
    Next para
    
    ' Den gesamten Abschnitt ersetzen, wenn ein Abschnitt gefunden wurde
    If foundSection Then
        range.Start = startRange.Start
        range.End = IIf(endRange.Style = startRange.Style, endRange.Start - 1, endRange.End)
        range.Text = "...pp..."
        range.Style = stl
    Else
        MsgBox "Der angegebene Abschnitt wurde nicht gefunden.", vbExclamation
    End If
End Sub

Gruß Mr. K.