One method
Sub SortMe()
Dim Lrow As Long, Lrow2 As Long
Dim arr As Variant
Dim cel As Range
Dim j As Variant
arr = Array(0, 1, 2)
Lrow = Range("a" & Rows.Count).End(xlUp).Row
For Each j In arr
For Each cel In Range("a2:a" & Lrow)
If cel.Offset(0, 1) = j Then
cel.Resize(1, 2).Copy
Range("c" & Range("c" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
End If
Next cel
Next j
Range("c2:d" & Range("c" & Rows.Count).End(xlUp).Row).Cut Range("a2")
End Sub
But a simple sort would suffice
Sub SortMe2()
Dim Lrow As Long
Lrow = Range("a" & Rows.Count).End(xlUp).Row
With ActiveSheet.Sort
.SortFields.Add Key:=Range("B1"), Order:=xlAscending
.SetRange Range("A1:b" & Lrow)
.Header = xlYes
.Apply
End With
End Sub
Bookmarks