nur für die letzten 10 Zeilen anwenden (auch@Sepp)

Sub SubstituteSave()
Dim arr() As String
Dim iCounter
Dim sSource As String, sTarget As String, sTxtA As String
Dim sTxtB As String, sTxt As String, sPath As String
Dim strMatch1 As String, strMatch2 As String
Dim intFront As Integer, intEnd As Integer
sPath = Range("B7").Value & "\" 'Pfad der Datei
sSource = sPath & Range("b1").Value ' Name der Textdatei
sTarget = sPath & Range("b4").Value ' Neuer Name der Textdatei
sTxtA = Range("b2").Value ' alter Text
sTxtB = Range("b3").Value ' neuer Text
strMatch1 = "<forecast-adjustment>" 'vordere Begrenzung
strMatch2 = "</forecast-adjustment>" 'hintere Begrenzung
Dim PrüferMatch1 As Boolean
chkMatch1 = 0
Close
Open sSource For Input As #1
Do Until EOF(1)
  Line Input #1, sTxt
  'If sTxt = sTxtA Then
  'MsgBox "treffer"
  'End If
  If InStr(1, sTxt, strMatch1) > 0 Then
    chkMatch1 = True
  End If
  If InStr(1, sTxt, strMatch2) > 0 Then
    chkMatch1 = False
  End If
  If chkMatch1 And sTxt <> strMatch1 And sTxt <> sTxtB Then
    intFront = InStr(1, sTxt, strMatch1) + Len(strMatch1)
    intEnd = InStr(1, sTxt, strMatch2) - 1
    sTxt = sTxtB
  End If
  iCounter = iCounter + 1
  ReDim Preserve arr(1 To iCounter)
  arr(iCounter) = sTxt
Loop
Close
Open sTarget For Output As #1
For iCounter = 1 To UBound(arr)
  Print #1, arr(iCounter)
Next iCounter
Close
On Error GoTo ERRORHANDLER
Shell "notepad " & sTarget, vbMaximizedFocus
MsgBox " Job erledigt!"
ERRORHANDLER:
End Sub