Combine, sort, & then create worksheet

[J.W. Aldridge]

I had trouble assembling a code to do the following, please assist....

1. Combine list from 3 specific sheets, into one "master" sheet.
(All data is on each sheet A:I - No headers)
Sheet 1 - "Apples"
Sheet 2 - "Oranges"
Sheet 3 - "Grapes

2. Sort Master sheet based on column A (groups), then B (names).

3. Create new sheets based on the names column B in the master sheet
(in the same order that the names appear).

 

[Mauro Gamberini]

You need a Sheet named Resume.

Public Sub m()

On Error GoTo ErrorRow

Dim sh As Worksheet
Dim shResume As Worksheet
Dim shNew As Worksheet
Dim rng As Range
Dim lLastRow As Long
Dim lFirstRow As Long

With Application
.ScreenUpdating = False
.Calculation = xlManual
.StatusBar = "Runs: Sub m()"
End With

Set shResume = Worksheets("Resume")

With shResume
.Rows("1:" & Rows.Count).Delete
.Select
ActiveSheet.UsedRange
End With

For Each sh In Worksheets
With shResume
lLastRow = _
.Range("A1").CurrentRegion.SpecialCells( _
xlCellTypeLastCell).Row + 1
End With
With sh
If .Name <> "Resume" Then
.Range("A1").CurrentRegion.Copy _
Destination:=shResume.Range( _
"A" & lLastRow)
End If
End With
Next

With shResume
.Rows("1:1").Delete
lLastRow = .Range("A1").CurrentRegion.SpecialCells( _
xlCellTypeLastCell).Row
.Range("A1").Select
.Range("A1:I" & lLastRow).Sort Key1:=Range("A1"), _
Order1:=xlAscending, Key2:=Range( _
"B1"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End With

Set shNew = Worksheets.Add
shResume.Range("B:B").Copy _
Destination:=shNew.Range("A1")

ExitRow:
Set rng = Nothing
Set sh = Nothing
Set shNew = Nothing
Set shResume = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.StatusBar = ""
End With
Exit Sub

ErrorRow:
MsgBox Err.Number & vbNewLine & Err.Description
Resume ExitRow

End Sub