宏花费很长时间和处理开销

Question

我有一个宏，它在单击相应字段的排序按钮上对列进行排序，并根据排序的字段调整其他列。它还会为排序值列加粗。值需要大约-6秒才能获得排序和粗体。这需要很多开销。

Macro我写的是，

Sub Sort_Macro_C()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set VerticalRange = Worksheets("Sheet1").Range("b9:b200")
Worksheets("Sheet1").Cells.Font.Bold = False
Worksheets("Sheet1").Range("c9:c200").Font.Bold = True
row = Application.WorksheetFunction.CountA(VerticalRange) + 10
Range(Cells(10, 2), Cells(row, 18)).sort Key1:=Range("C9"), Order1:=xlDescending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortTextAsNumbers
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

用于排序其他列

Sub Sort_Macro_D()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set VerticalRange = Worksheets("Sheet1").Range("b9:b200")
Worksheets("Sheet1").Cells.Font.Bold = False
Worksheets("Sheet1").Range("D9:D200").Font.Bold = True
row = Application.WorksheetFunction.CountA(VerticalRange) + 10
Range(Cells(10, 2), Cells(row, 18)).sort Key1:=Range("D9"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortTextAsNumbers
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub 

请建议我删除此处理开销，并在点击指定按钮时运行排序和粗体功能。