Sub test()
Dim x, Prefix As String, Arr
With Sheets("Liste")
Prefix = .[e3]
x = Filter(.Evaluate("transpose(if(left(d3:d685," & Len(Prefix) & _
")=""" & Prefix & """,row(1:1)))"), False, 0)
If UBound(x) = -1 Then Exit Sub
Arr = Application.Index(.Range("d3:d685").Value, Application.Transpose(x), [transpose(row(1:1))])
If UBound(x) = 0 Then
.[f3].Resize(, UBound(Arr)) = Arr
Else
.[f3].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End If
End With
End Sub