Hallo Christy! Erstmal ein gesundes Neues Jahr. Anbei dann der Code für den Wunsch. Dein Folgeproblem hätte ich auch gleich mit eingebaut, aber da wusste ich nicht wie (nicht im einzelnen, abstrakt reicht eigentlich) die Bezeichnungen in Datei1 Spalte D stehen - insb. wenn mehrer Werte vorkommen. Gruß

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
Dim j As Long              'Variable zu zählen
Dim l As Long
Dim k As Long
Dim letzter
Dim temp As String
Dim zeilen As Long
Dim parameter() As String
Dim spalte As Long
Dim loschen() As Byte

Application.ScreenUpdating = False

ziel = ThisWorkbook.Name
pfad = "C:\Users\ich\Desktop\Programmieung\hallo\Neuer Ordner"     'noch anpassen
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"

quelle = "Datei2.xls"  'x

ReDim loschen(0)
loschen(0) = 0

ReDim parameter(6, Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
parameter(1, 0) = 0
parameter(3, 0) = 0
parameter(5, 0) = 4
'parameter auslesen
For i = 1 To Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    If Workbooks(ziel).Worksheets(1).Cells(i, 1) <> "" Then
        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 ""
                
                Case Else
                    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
    End If
Next i

'Dateien laden
ziel = ThisWorkbook.Name
pfad = "C:\Users\ich\Desktop\Programmieung\hallo\Neuer Ordner"     'noch anpassen
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"

quelle = "Datei2.xls"  'x

Workbooks.Open Filename:=pfad & quelle
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
ReDim loschen(zeilen)

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

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

For k = 1 To 3
    For l = 1 To parameter(2 * k - 1, 0)

        suche = parameter(2 * k - 1, l)
        If suche <> "" Then
            ersetz = parameter(2 * k, l)
            If k = 1 Or k = 2 Then
                spalte = 3
            Else
                spalte = 4
            End If
            
            With Workbooks(quelle).Worksheets(1).Columns(spalte)
            Set ergebnis = .Find(suche, LookIn:=xlValues)

            If Not ergebnis Is Nothing Then
                letzter = Application.WorksheetFunction.CountIf(Workbooks(quelle).Worksheets(1).Columns(spalte), "*" & suche & "*")
               
                For j = 1 To letzter
                    If ersetz = "" And k = 1 Then
                        loschen(0) = loschen(0) + 1
                        loschen(ergebnis.Row) = 1
                    Else
                        Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte) = Replace(Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte), suche, ersetz)
                    End If
                    Set ergebnis = .FindNext(ergebnis)
                Next j
                
             End If
   
            End With
            Set ergebnis = Nothing
          
        End If 'Verglich ob leer
    Next l
Next k

'jetzt löschen
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

Workbooks(quelle).Close savechanges:=True

Application.ScreenUpdating = True
End Sub