excel - vba 分割命名

Sub 執行()

x = 0
Sheets(1).Select
排序

While (ActiveCell.Value <> Empty)

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

x = x + 1
End If

ActiveCell.Offset(1, 0).Select

Wend

Range("F1").Select



Sheets(1).Select
For i = 1 To x - 1 Step 1
Sheets.Add
Next

Sheets("資料").Move Before:=Sheets(1)
命名

End Sub
Sub 排序()

Range("F1").Select
Range("A1:H65535").Sort Key1:=Range("F1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlStroke, DataOption1:=xlSortNormal
End Sub

Sub 命名()

Range("F2").Select
i = 1
While (ActiveCell.Value <> Empty)

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

Else
i = i + 1
Sheets(i).Name = ActiveCell.Offset(-1, 0).Value

End If

ActiveCell.Offset(1, 0).Select

Wend

Range("F1").Select
End Sub

Sub 搬移()

n = ActiveCell.Value
r = ActiveCell.Row
r = r & ":" & r
Rows(r).Select
Selection.Copy
Sheets(n).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub