Sorry! Ändere bitte mal die Zeile 49. Da steht derzeit

 If i < 75 And i > 79 Then

es muss aber lauten

 If i < 75 or i > 79 Then

. Dann sollte es m.M.n. klappen. Das war wieder so nen Murks. Ein I mit der Beschreibung gibt es nicht. Deshalb kam er auch nicht zu den Parameter auf Blatt 1. Bei ja wird aber auch nix gemacht mit den Parameter von Blatt 2!? Habe dann noch einen Copy / paste fehler gefunden. In Zeile 102 muss statt i der INdex k rein. Unten jezt mal der richtige Code. Wäre ja auch zu schön gewesen, wenn es gleich auf Anhieb gepasst hätte. :-D

Zum Redim. Beim Dimensioniern meinte ich bei meinem Kommentar den aktuellen Wert. Könnte ja sein, dass in Blatt 2 mehr Parameter als in Blatt 1 (das war die max. Anzahl der Parameter) stehen und dann hätte wir einen Fehler. Am Anfang (zeile 39) sagen wir ja, dass es bis max. Ende1 also Parameteranzahl in Blatt 1 gehen soll. Deshalb steht da bei mir ein Redim Preserve - Redim alleine legt zwar neu fest, löscht aber den INhalt. Redim PReserve legt neu fest, behält den INhalt. Während der Bearbeitung kann man aber nur den rechten Wert ändern. Die 8 bleibt, weil wir ja auch keine anderen Parameterarten haben. Wenn du die 8 erhöhst, hättets du in der "Parametertabelle", zwei neue Zeilen aber keine weiteren Spalten. (Eselsbrücke: 1. Wert immer die Zeilen, 2. WErt die Spaltenanzahl)

Viele Grüße

Option Explicit

Sub ersetzen()

Dim ziel As String      'die Datei mit dem Code
Dim quelle As String    'die Datei in der ersetz wird
Dim pfad As String      'Pfad zur Datei in der ersetzt wird
Dim suche As String     'der Text der gesucht wird, PARAMETER
Dim ersetz              ' Wert die dann eingefügt werden , Spalte 3
Dim ergebnis As Object           'Rückgabewert des Ersetzen
Dim i As Long               'Variable zu zählen
Dim j As Long               'Variable zu zählen
Dim l As Long               'Variable zu zählen
Dim k As Long               'Variable zu zählen
Dim letzter                 'Anzahl der Vorkommen der parameter
Dim temp As String          'nimmt kurzzeitig die Parameter von Blatt 1 auf
Dim zeilen As Long          'die Anzahl der Zeile in denen gelöscht wird
Dim parameter() As String   ' nimmt alle Parameter + Werte dazu auf
Dim spalte As Long          ' die Spalte wo gesuch wird
Dim loschen() As Byte       ' Array für die Zeilen, hier wird mit 1 eingetragen, wenn gelöscht werden soll
Dim ende1 As Integer        ' Zeile der letzten Eintragungen Blatt 1
Dim ende2 As Integer        ' Zeile der letzten Eintragungen Blatt 1

'Änderungen nicht sichtbar machen - Bildschirm einfrieren
Application.ScreenUpdating = False

'Pfade Namen etc. festlegen
ziel = ThisWorkbook.Name
pfad = "   "     'noch anpassen
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"

quelle = "Datei2.xlsx"  'x

'letzte gefüllte Zeile in Spalte A auf Blatt 1 und 2
ende1 = Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ende2 = Workbooks(ziel).Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row

'parameter dimensionieren, jetzt mit 8 zeilen
ReDim parameter(8, ende1)
parameter(1, 0) = 0
parameter(3, 0) = 0
parameter(5, 0) = 4
parameter(7, 0) = 0

'parameter aus blatt 1 auslesen
For i = 1 To ende1
    If Workbooks(ziel).Worksheets(1).Cells(i, 1) <> "" Then
    ' wenn zwischen A 74 bis 79 was steht dann in der else schleife die packages prüfen
    If i < 75 Or i > 79 Then
        'Parameternamen auswerten
        temp = Workbooks(ziel).Worksheets(1).Cells(i, 1)
        If Len(temp) <> Len(Replace(temp, "pBUKRS", "")) Then
            'ein Parameter der Sorte pBUKRS%%
                parameter(1, 0) = parameter(1, 0) + 1
                parameter(1, parameter(1, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 1)
                parameter(2, parameter(1, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
       
        Else
            Select Case temp
            
                Case "pBUDATto"
                    parameter(5, 1) = "pBUDATto"
                    parameter(6, 1) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
                    
                Case "pUDATEto"
                    parameter(5, 2) = "pUDATEto"
                    parameter(6, 2) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
                    
                Case "pZALDTto"
                    parameter(5, 3) = "pZALDTto"
                    parameter(6, 3) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
                    
                Case "pWADAT_ISTto"
                    parameter(5, 4) = "pWADAT_ISTto"
                    parameter(6, 4) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
                
                Case ""
                    'leer sollte eigentlich nix mehr sein, aber man weiß ja nie
                
                Case Else
                    'die mit dem gleiche aufbau hatten wir schon, die 4 speziellen auch, bleiben nur die anderen
                    parameter(3, 0) = parameter(3, 0) + 1
                    parameter(3, parameter(3, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 1)
                    parameter(4, parameter(3, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
                    
            End Select
        End If
    Else
    'jetzt sind wir im Bereich der packages in Blatt 1
        'nur wenn rechts davon nein steht, die parameter prüfen
        If Workbooks(ziel).Worksheets(1).Cells(i, 2) = "nein" Then
            'jetzt mal alles packages in Blatt 2 prüfen
            For k = 1 To ende2
                'packagename in Blatt1 ist identisch mit dem in der Zelle in Blatt 2
                If Workbooks(ziel).Worksheets(1).Cells(i, 1) = Workbooks(ziel).Worksheets(2).Cells(k, 1) Then
                    'Anzahl der parameter in zeile 7 um ein erhöhenb
                    parameter(7, 0) = parameter(7, 0) + 1
                    'da wir aus Blatt 2 lesen könnten es ggf. mehr parameter als in der Dimensionierung sein, deshalb mal prüfen ob es noch passt
                    ' wenn nicht, dann die Dimension von parameter unter Beibehaltung der Einträge erhöhen.
                    If ende1 < parameter(7, 0) Then ReDim Preserve parameter(8, parameter(7, 0))
                    'Wert für den parameter zuweisen, wenn er nicht leer ist
                    If Workbooks(ziel).Worksheets(2).Cells(k, 2) <> "" Then parameter(7, parameter(7, 0)) = Workbooks(ziel).Worksheets(2).Cells(k, 2)
                End If
            Next k
        End If 'prüfung auf nein bei packages
    End If ' prüfung für bereich der package
    End If 'Prüfung leer
Next i

'datei öffnen
Workbooks.Open Filename:=pfad & quelle

'schauen wieviele Zellen beschrieben sind, gesucht wird in Spalte A, C und D
zeilen = Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 3).End(xlUp).Row
If zeilen < Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row Then zeilen = Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row
If zeilen < Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row Then zeilen = Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

'loschen dimensionieren
ReDim loschen(zeilen)

For k = 1 To zeilen
    loschen(k) = 0
Next k

For k = 1 To 4
    'festlegen wo gesucht wird
    If k = 1 Or k = 2 Then
        spalte = 3
    ElseIf k = 3 Then
        spalte = 4
    Else
        'bei k = 4
        spalte = 1
    End If
    
    For l = parameter(2 * k - 1, 0) To 1 Step -1
        'Namen der parameter holen
        suche = parameter(2 * k - 1, l)
        If suche <> "" Then
            'Wert zum ersetzen holen
            ersetz = parameter(2 * k, l)
            
            With Workbooks(quelle).Worksheets(1).Columns(spalte)
            'suchen
            Set ergebnis = .Find(suche, LookIn:=xlValues)

            If Not ergebnis Is Nothing Then
                'wenn was gefunden, suchen wie oft das in der Spalte vorkommt
                letzter = Application.WorksheetFunction.CountIf(Workbooks(quelle).Worksheets(1).Columns(spalte), "*" & suche & "*")
               
                For j = 1 To letzter
                    If (ersetz = "" And k = 1) Or k = 4 Then
                    ' löschen nur bei k =1 und k = 4
                        loschen(ergebnis.Row) = 1
                    Else
                        ' Werte ersetzen
                        Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte) = Replace(Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte), suche, ersetz)
                    End If
                    'nächsten Wert finden
                    Set ergebnis = .FindNext(ergebnis)
                Next j
                
             End If
   
            End With
            Set ergebnis = Nothing
          
        End If 'Vergleich ob leer
    Next l
Next k

'jetzt löschen, dazu einfach alle Zeilen durchgehen und schauen ob eine 1 steht.
For j = UBound(loschen) To 1 Step -1
      If loschen(j) = 1 Then Workbooks(quelle).Worksheets(1).Rows(j).Delete
Next j

Application.CutCopyMode = False
Workbooks(ziel).Activate
'schließeb mit speichern
Workbooks(quelle).Close savechanges:=True
'Änderungen sichtbar machen
Application.ScreenUpdating = True
End Sub