Extracting selected data into new worksheets

Try this:

Sub Macro2()
 
Dim rng As Range, rng2 As Range, ws As Worksheet
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False

With Sheet1
    Sheets.Add().Name = "Temp"
    .Range("E1", .Range("E1").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Temp").Range("A1"), Unique:=True
    Set rng2 = Sheets("Temp").Range("A2", Sheets("Temp").Range("A2").End(xlDown))
     For Each rng In rng2
        .Range("A1").AutoFilter field:=5, Criteria1:=rng
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        .AutoFilter.Range.Copy ws.Range("A1")
        ws.Name = rng
        .Range("A1").AutoFilter field:=1
    Next rng
    Sheets("Temp").Delete
    .AutoFilterMode = False
End With
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Stephen, that is excellent. I'm no expert in analysing the code but a quick question.

Does this code work for unlimited product and unlimited number of rows/columns or will I need to adapt it if my ranges increase.

Many Thanks

My pleasure.

It should work for any amount of data and any number of products as long as your products remain in column E (the 5 in the AutoFilter line) and there are no completely blank rows in your data.

Stephen, That has ben so helpful thank you very much. How do I show this topic as solved?

For future reference, see "How To" at the top of the page.

To mark your thread solved do the following:
- Go to the first post
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solve
- Click Save