@Josef Ehrensberger / Beitrag leider nicht mehr

Hallo Josef
Habe eine Lösung erarbeitet, weicht aber von Deinem Vorschlag ab, weil eine Fehlermeldung beim Teil des Replace erfolgte.
Ist dieser Weg fals aufgesetzt?
Danke für Deine Prüfung
Sub SubstituteSave()
Dim arr() As String
Dim iCounter 'musste die "as Integer" Zuweisung löschen überlauf Fehler 6
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
Dim PrüferMatch1 As Boolean
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
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
'nach erfolgreicher Prüfung der oberen Eingrenzung wird die chkMatch1 auf true gesetzt
If InStr(1, sTxt, strMatch1) > 0 Then
    chkMatch1 = 1
End If
'nach erfolgreicher Prüfung der unteren Eingrenzung wird die chkMatch1 auf false gesetzt
If InStr(1, sTxt, strMatch2) > 0 Then
    chkMatch1 = 0
End If
'wenn chkMatch1 True und sText ist nicht obere Eingrenzung und der String ist ungleich des Sollwert dann
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
Gruss
Martin