VBA代码怎么简化？VBA 代码怎么简化？

Question

Sub Macro9()

Dim g As Integer
For g = 1 To Worksheets.Count
Worksheets(g).Name = "Sheet" & g
Next

Rows("2:10").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A10") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
    "US,CA,FR,EU,IT,UK,MX,CN,KR", DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A2:S10")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Rows("16:36").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B16:B36") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
    "EN,CA,FR,DE,DK,ES,FI,IT,SP,NL,NO,PL,SE,AR,JP,CN,KR,RU,GR,ID,PT", DataOption _
    :=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A16:S36")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Rows("45:65").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B45:B65") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
    "EN,CA,FR,DE,DK,ES,FI,IT,SP,NL,NO,PL,SE,AR,JP,CN,KR,RU,GR,ID,PT", DataOption _
    :=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A45:S65")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Rows("40:41").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A40:S40") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
    "English,French,German,Danish,Finnish,Italian,Latin Spanish,Dutch,Norwegian,Polish,Swedish,Arabic,Japanese,Chinese (simplified),Korean,Spain (Spain-Spanish),Russian,Greek,Indonesian,Portuguese,FRENCH CANADIAN,COMBINE" _
    , DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A40:S41")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlLeftToRight
    .SortMethod = xlPinYin
    .Apply
End With

ActiveWorkbook.SaveAs FileName:= _
ThisWorkbook.Path & "/Data-" & Format(Now, "YYYY-MM-DD-HHmmSS") & ".xlsm”, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

End Sub