For ohne Next

Sub Dokumentenbefuellung()
Application.ScreenUpdating = False
Const wdReplaceAll = 2
Const wdNoProtection = -1
Dim oAppWD As Object, oDoc As Object
Dim x, i, a, b, y  As Variant
Dim Dokumente, Ueberschrift, strString, Oberordner, prjname As String
Dim rngCell As Range
Oberordner = ActiveWorkbook.Sheets("Eingabefenster").Range("B6").Value
prjname = ActiveWorkbook.Sheets("Eingabefenster").Range("B18").Value
If Dir(Dokumente)  "" Then ' Falls ein Dokument existiert, soll die Word Applikation  _
gestartet werden
Set oAppWD = CreateObject("Word.Application") 'Word als Object starten
Else
MsgBox "Die zu öffnende Dokumentdatei wurde nicht gefunden!", vbCritical, "Word-Datei öffnen" _
_
End
End If
If Not oAppWD Is Nothing Then
oAppWD.Visible = True
If oAppWD.Options.AllowReadingMode = True Then 'Word nicht im Lesemodus starten bei  _
Schreibgeschützten Dokumenten
oAppWD.Options.AllowReadingMode = False
End If
End If
b = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To b
Dokumente = "Pfad"
Set oDoc = oAppWD.Documents.Open(Dokumente)
Application.DisplayAlerts = False
If Not oDoc Is Nothing Then
If oDoc.ProtectionType  wdNoProtection Then
oDoc.Unprotect
End If
End If
ThisWorkbook.Activate
Sheets("Worddokumente").Activate
x = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To x
Ueberschrift = "Überschrift" & " " & ActiveWorkbook.Sheets("Worddokumente").Cells(i, 2) _
_
.Value
ThisWorkbook.Activate
With oAppWD.Selection.Find
.Forward = True
.ClearFormatting
.Style = Ueberschrift
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdfindContinue
.Execute FindText:=ActiveWorkbook.Sheets("Worddokumente").Cells(i, 3).Value
End With
oAppWD.Selection.InsertParagraphAfter
oAppWD.Selection.InsertAfter Text:=ActiveWorkbook.Sheets("Worddokumente").Cells(i,   _
_
4).Value
oAppWD.Selection.Font.Color = wdColorOrange
Next i
oDoc.Save         'Dokument speichern
oDoc.Close        'Dokument schließen
oAppWD.Quit       'Word schließen
Set oAppWD = Nothing
Set oDoc = Nothing
End Sub