Option Explicit
Sub Makro1()
Dim Z As Variant
Dim a$
Dim le
Dim pos
Dim b As Integer
Dim z2 As Integer
Tabelle1.Select
For Z = 2 To 1000:
a$ = Cells(Z, 1)
If a$ <> "" Then
a$ = Tabelle1.Cells(Z, 1): le = Len(a$)
pos = InStr(a$, "foci")
If pos > 0 Then
b = 9
If b > (le - pos + 1) Then b = le - pos + 1
If b = 9 Then
Tabelle2.Select
z2 = 1
While Tabelle2.Cells(z2, 2) <> ""
z2 = z2 + 1
Wend
Tabelle2.Cells(z2, 2) = Mid(a$, pos, b)
Tabelle1.Select
End If
End If
End If
Next Z
End Sub