Try
Sub test()
Dim a, e, i As Long, dic As Object
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("master").Cells(1).CurrentRegion
a = .Columns(1).Value
For i = 2 To UBound(a, 1)
If Not dic.exists(a(i, 1)) Then
Set dic(a(i, 1)) = .Rows(1)
End If
Set dic(a(i, 1)) = Union(dic(a(i, 1)), .Rows(i))
Next
End With
For Each e In dic
If Not Evaluate("isref('" & e & "'!a1)") Then
Sheets.Add(, Sheets(Sheets.Count)).Name = e
End If
Sheets(e).UsedRange.Clear
dic(e).Copy Sheets(e).Cells(1)
Next
Application.ScreenUpdating = True
End Sub
Or AutoFilter
Sub testFilter()
Dim a, i As Long, dic As Object
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("master").Cells(1).CurrentRegion
a = .Columns(1).Value
For i = 2 To UBound(a, 1)
If Not dic.exists(a(i, 1)) Then
dic(a(i, 1)) = Empty
If Not Evaluate("isref('" & a(i, 1) & "'!a1)") Then
Sheets.Add(, Sheets(Sheets.Count)).Name = a(i, 1)
End If
Sheets(a(i, 1)).Cells.Clear
End If
.AutoFilter 1, a(i, 1)
.Copy Sheets(a(i, 1)).Cells(1)
Next
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
Bookmarks