Sub ReplaceFromList() 
Dim i As Long 
Dim lastRow As Long 
Dim varSearch As Variant 
Dim rng As Range 
Dim rngSearch As Range 
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 
Set rngSearch = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) 
 
Application.ScreenUpdating = False 
 
For i = 2 To lastRow 
    varSearch = Range("A" & i) 
    For Each rng In rngSearch 
        If InStr(rng, varSearch) > 0 Then 
            Range("C" & i) = rng.Value 
            Exit For 
        End If 
    Next rng 
Next i 
 
Set rng = Nothing 
Set rngSearch = Nothing 
 
End Sub 

Sub ReplaceFromList() 
 
'Deklarieren der Variablen: 
'Long für Zeilen 
'Variant für Suchwort 
'Range für Zelle und Zellbereiche 
 
Dim i As Long 
Dim lastRow As Long 
Dim varSearch As Variant 
Dim rng As Range 
Dim rngSearch As Range 
 
'Ermitteln der letzten Zeile von Spalte A 
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 
'Definieren des Suchbereichs in Spalte B: von Zeile 2 bis letzte Zeile Spalte B 
Set rngSearch = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row) 
 
'Bildschirmflackern ausschalten 
Application.ScreenUpdating = False 
 
'Die erste For-Next-Schleife durchsucht Spalte A nach dem 1. Suchwort, 
'beginnend bei Zeile 2 
For i = 2 To lastRow 
    'Das Suchwort in die Variable laden 
    varSearch = Range("A" & i) 
    'Mit der 2. For-Next-Schleife wird jede Zelle in Spalte B (rngSearch) beginnend 
    'von Zeile 2 bis Ende Spalte B auf das Suchwort (varSearch) untersucht 
    For Each rng In rngSearch 
        'Falls Suchwort gefunden ... 
        If InStr(rng, varSearch) > 0 Then 
            '... dann setze den Wert in Spalte C in die gleiche Zeile (i) wie das Suchwort ... 
            Range("C" & i) = rng.Value 
            '... und verlasse die innere Schleife ... 
            Exit For 
        'Ende der If-Anweisung 
        End If 
    '(Ende innere Schleife) 
    Next rng 
' ... und erhöhe die Variable i um 1 
'Dann gehe an den Anfang der ersten Schleife und lade 
'das nächste Suchwort in die Variable 
Next i 
 
'Die Range-Variablen zurücksetzen 
Set rng = Nothing 
Set rngSearch = Nothing 
 
End Sub