Option Explicit
Sub Test()
Dim strText As String
strText = "Max Mustermann" & vbNewLine & _
"Straße xy" & vbNewLine & _
"Musterhausen " & vbNewLine & _
"Kontoverbindung: DE831293719237912321132 " & vbNewLine & _
"Bericht-Nr: 232131413" & vbNewLine & _
"Untersuchuchungswunsch: Untersuche mir bitte das Produkt XY auf den Fehler Z" & vbNewLine & _
"Last: 1200 kN" & vbNewLine & _
"Drehzahl: 2000 1/min" & vbNewLine & _
"Schmierung: Öl"
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.MultiLine = False
Dim strPattern As String
strPattern = WorksheetFunction.TextJoin("|", True, Worksheets("Tabelle1").Range("B:B"))
.Pattern = "([?*+.\\()\[\]])"
strPattern = .Replace(strPattern, "\$1")
strPattern = "(?:" & strPattern & ") ([^\r\n]+)"
.Global = False
.Pattern = strPattern
With .Execute(strText)
If .Count > 0 Then
Debug.Print .Item(0).SubMatches(0)
End If
End With
End With
End Sub