Hi neilosj,
Try below code ...
Sub test()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Sheet1") '<-- change sheet name as needed
a = ws.[A5].CurrentRegion
With CreateObject("scripting.dictionary")
For x = 2 To UBound(a)
If Not .exists(a(x, 1)) Then
.Add a(x, 1), Nothing
ws.Copy , Sheets(Sheets.Count)
With ActiveSheet.[A5].CurrentRegion
.AutoFilter 1, "<>" & a(x, 1)
.Offset(1).EntireRow.Delete
.AutoFilter
.Parent.[B2] = a(x, 1)
.Parent.Name = a(x, 1)
End With
End If
Next
End With
End Sub
Bookmarks