Sub Tach_Sheet()
Dim Dic As Object, sArr(), i As Long, Tmp As String, MyRange As Range, Item As Variant
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
sArr = .Range("A1").CurrentRegion.Value
Set MyRange = .Range("A1").CurrentRegion
End With
For i = 2 To UBound(sArr) - 2
Tmp = sArr(i, 5)
If Tmp <> Empty Then Dic(Tmp) = Empty
Next
For Each Item In Dic.keys
MyRange.AutoFilter 5, Item
MyRange.SpecialCells(xlCellTypeVisible).Copy
With Sheets.Add
MyRange.SpecialCells(xlCellTypeVisible).Copy .Range("A1")
.Name = Item
End With
MyRange.AutoFilter
Next
End Sub