Option Explicit
Private Const REGEXPATTERN As String = "from\s"
Private Const TABLENAME_FROM As String = "Tabelle1"
Private Const TABLENAME_TO As String = "Tabelle2"
Public Sub search_and_transfer()
Dim regEx As New RegExp
With regEx
.Pattern = REGEXPATTERN
.Global = True
.IgnoreCase = True
.MultiLine = False
End With
Dim l As Long
l = 1
With Worksheets(TABLENAME_FROM)
Do While Not .Cells(l, 1).Value = vbNullString
If regEx.Test(.Cells(l, 1).Value) Then
Worksheets(TABLENAME_TO).Cells(get_next_empty_row, 1).Value = Left(regEx.Replace(.Cells(l, 1), ""), InStr(1, regEx.Replace(.Cells(l, 1), ""), " ", vbTextCompare) - 1)
End If
l = l + 1
Loop
End With
Set regEx = Nothing
End Sub
Private Function get_next_empty_row() As Long
Dim l As Long
l = 1
With Worksheets(TABLENAME_TO)
Do While Not .Cells(l, 1).Value = vbNullString
l = l + 1
Loop
End With
get_next_empty_row = l
End Function