Splitting up part numbers in to different sheets

the main sheet is called sheet1.

try this macro (keep the function also in the same module)

Sub test()
Dim r As Range, rb As Range, sockets As Range, csocket As Range, x As String
With Worksheets("sheet1")
Set r = .Range("A1").CurrentRegion
Set rb = Range(.Range("B1"), .Range("B1").End(xlDown))
Set sockets = .Range("A1").End(xlDown).Offset(5, 0)
rb.AdvancedFilter xlFilterCopy, , sockets, True
Set sockets = Range(sockets.Offset(1, 0), sockets.End(xlDown))
For Each csocket In sockets
x = csocket.Value
r.AutoFilter field:=2, Criteria1:=x
r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count).SpecialCells(xlCellTypeVisible).Copy
If Not SheetExists(x) Then
Worksheets.Add
ActiveSheet.Name = x
Else
GoTo nextstep
End If
nextstep:
With Worksheets(x)
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
r.AutoFilter
Next csocket
End With

End Sub

Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
    'taken from web
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(Sheets(SheetName).Name) > 0 Then
        SheetExists = True
        Exit Function
    End If
NoSuchSheet:
End Function

Sub undo()
Dim j As Long
Application.DisplayAlerts = False
For j = Worksheets.Count To 1 Step -1
If Worksheets(j).Name = "Sheet1" Then GoTo nextj
Worksheets(j).Delete
nextj:
Next j
With Worksheets("sheet1")
Range(.Range("A1").End(xlDown).Offset(1, 0), .Cells(Rows.Count, "A")).EntireRow.Delete
End With
Application.DisplayAlerts = True

End Sub