Option Explicit
Public Sub Verteilen()
Dim varArray As Variant, varItem As Variant, objDic As Object
Application.ScreenUpdating = False
Set objDic = CreateObject("Scripting.Dictionary")
With Worksheets("Tabelle1")
varArray = .Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row).Value
With objDic
For Each varItem In varArray
.Item(Key:=varItem) = vbNullString
Next
End With
For Each varItem In objDic.keys
.Range("A1").AutoFilter field:=5, Criteria1:=varItem
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
End With
With Worksheets(varItem)
.Cells(.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row, "A") _
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Next varItem
.Range("A1").AutoFilter
End With
Set objDic = Nothing
Application.CutCopyMode = False
End Sub