Option Explicit
Sub ersetzen()
Dim ziel As String
Dim quelle As String
Dim pfad As String
Dim suche As String
Dim ersetz
Dim ergebnis
Dim anzparameter As Long
Dim namequelle As String
Dim i As Long
Application.ScreenUpdating = False
ziel = ThisWorkbook.Name
pfad =
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
quelle = "Datei2.xlsx"
namequelle = "Datei2"
If ActiveSheet.Cells(1, 1) <> "" Then
anzparameter = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open Filename:=pfad & quelle
For i = anzparameter To 1 Step -1
suche = Workbooks(ziel).Worksheets(1).Cells(i, 1).Value
If suche <> "" Then
ersetz = Workbooks(ziel).Worksheets(1).Cells(i, 5).Value
ergebnis = Workbooks(namequelle).Worksheets(1).Columns(3).Replace(suche, ersetz, xlPart, , True)
End If
Next i
Application.CutCopyMode = False
Workbooks(ziel).Activate
Workbooks(quelle).Close savechanges:=True
End If
Application.ScreenUpdating = True
End Sub