See if you can modify these to your needs.
Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData

End Sub

Sub FilterData()
'by Bob Phillips
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
With Range("B1:B" & iLastRow)
.AutoFilter Field:=1, Criteria1:="SC"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Worksheets("Sheet2").Range("A1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="SU"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Worksheets("Sheet3").Range("A1")
.AutoFilter
End With
End Sub

Mike F
"****al shah" wrote in message
...
Hi
How do I separate each sort order and move to next blank column with
heading
and also how I automatically change range of data.


Sub changeorder()
Range("A4").Select
Range("A1:A110").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=
_
xlYes, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns(1).Copy Cells(1, 256).End(xlToLeft)(1, 2).EntireColumn
End Sub