Ускорьте работу макроса VBA: откройте / закройте несколько книг для сортировки данных

Question

Я написал макрос для обработки всех файлов Excel в выбранной пользователем папке, а затем сохранил обработанные файлы как новый файл в новой папке («ФИНАЛЬНЫЙ»). Макрос у меня работает, но работает медленно. Есть ли у вас какие-либо предложения относительно того, как я могу улучшить скорость?

Sub PreProcessing()

Application.Calculation = xlCalculationManual
Application.EnableAnimations = False
Application.DisplayStatusBar = False

'Choose Folder
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
    With FolderPath
        .AllowMultiSelect = False
        .Show
    End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ChosenFolder = FolderPath.SelectedItems(1)
GetDirectory = Mid(ChosenFolder, InStrRev(ChosenFolder, "\") + 1)
ChosenFile = Dir(ChosenFolder & "\*Output_Final*")

'Loop through files in the folder
Do While Len(ChosenFile) > 0

    'Open The Workbook
    Workbooks.Open Filename:=GetDirectory & "\" & ChosenFile

    'Format "Notes" Worksheet
    With Cells
        .ClearFormats
        .RowHeight = 14.4
        .ColumnWidth = 8.11
    End With

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A" & LR).ClearContents

    Range(Cells(1,1), Cells(1,1).End(xlToRight)).AutoFilter
    ActiveWorkbook.Worksheets("Notes").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Notes").AutoFilter.Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Notes").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range(Cells(1,1), Cells(1,1).End(xlToRight)).AutoFilter


    'Format "Orders" Worksheet
    Sheets("Orders").Select
    With Cells
        .ClearFormats
        .RowHeight = 14.4
        .ColumnWidth = 8.11
    End With

    LastCell = Range("A1").SpecialCells(xlCellTypeLastCell).Address
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Orders").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Orders").Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Orders").Sort
        .SetRange Range("A2:" & LastCell)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Delete remaining sheets
    Application.DisplayAlerts = False
        Sheets("C").Delete
        Sheets("D").Delete
        Sheets("E").Delete

    'Save file
    Sheets("Notes").Select

    strFileFullName = ActiveWorkbook.FullName
    SaveHere = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, "\")) & "FINAL\"
    NewName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & "_i2e"
    newFileFullPath = SaveHere & NewName & ".xlsx"

    ActiveWorkbook.SaveAs Filename:=newFileFullPath
    ActiveWorkbook.Close
    ChosenFile = Dir

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableAnimations = True
Application.DisplayStatusBar = True

MsgBox "Pre-Processing Complete for " & GetDirectory

End Sub

Вопросы:

1) Могу ли я обработать эти файлы без фактического открытия и закрытия файла Excel? Замедляет ли открытие и закрытие файла процесс?

2) Есть ли лучший способ кодирования процесса сортировки? Для рабочего листа («Примечания») имеются данные во всех строках столбца «А», а в рабочем листе («Заказы») столбец «А» содержит пустые пропуски (3-5 пустых строк между строками с данными).

Спасибо за вашу помощь!

ahhn