EXCEL VBA

Sub 資料分割()


流水號

排序

資料搬移

End Sub

Sub 流水號()



Dim mystop



Range("A1").Select

mystop = Selection.End(xlDown).Row



Columns("A:A").Select

Selection.Insert Shift:=xlToRight

Range("A1").Value = "編號"

Range("A2").Value = 1

Range("A2").Select

Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _

Step:=1, Stop:=mystop - 1, Trend:=False

End Sub

Sub 排序()

Dim mystop, newrng, newname



Range("A1").Select

mystop = Selection.End(xlDown).Row



Range("B1").Select

newrng = "A1:G" & mystop

Range(newrng).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlStroke, DataOption1:=xlSortNormal



Range("B2").Select





For i = 1 To mystop - 1



If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then



newname = ActiveCell.Value

ActiveCell.Offset(1, 0).Select





Else







Sheets.Add

Sheets(Sheets.Count - 1).Name = newname



Sheets(Sheets.Count).Select

ActiveCell.Offset(1, 0).Select





End If

Next



End Sub

Sub 資料搬移()

'

For i = 1 To Sheets.Count - 1



Sheets(Sheets.Count).Select

Range("A1").Select

Selection.AutoFilter

Selection.AutoFilter Field:=2, Criteria1:=Sheets(i).Name

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

Sheets(i).Select

Range("A1").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Sheets(Sheets.Count).Select

Range("A1").Select

Selection.AutoFilter



Next

End Sub