Макросы в Excel

Sub SortSheets()
    ' сортировка листов книги по алфавиту
   Dim astrSheetNames() As String  ' Массив для хранения имен листов
   Dim intSheetCount As Integer, i As Integer, objActiveSheet As Object
    If ActiveWorkbook Is Nothing Then Exit Sub
    ' Проверка защищенности структуры рабочей книги
   If ActiveWorkbook.ProtectStructure Then MsgBox "Структура книги " & ActiveWorkbook.Name _
     & " защищена. Сортировка листов невозможна.", vbCritical: Exit Sub
    Set objActiveSheet = ActiveSheet    ' Сохраняем ссылку на активный лист книги
   ' Application.EnableCancelKey = xlDisabled' Отключение сочетания клавиш Ctrl+Pause Break
   Application.ScreenUpdating = False
    intSheetCount = ActiveWorkbook.Sheets.count

    ReDim astrSheetNames(1 To intSheetCount)    ' Заполнение массива astrSheetNames именами листов книги
   For i = 1 To intSheetCount
        astrSheetNames(i) = ActiveWorkbook.Sheets(i).Name
    Next i

    Call Sort(astrSheetNames)    ' Сортировка массива имен в порядке возрастания

    For i = 1 To intSheetCount    ' Перемещение листов книги
       ActiveWorkbook.Sheets(astrSheetNames(i)).Move ActiveWorkbook.Sheets(i)
    Next i

    objActiveSheet.Activate    ' Переход на исходный рабочий лист
   Application.ScreenUpdating = True
    ' Application.EnableCancelKey = xllnterrupt' Включение сочетания клавиш Ctrl+Pause Break
End Sub

Sub Sort(astrNames() As String)    ' Сортировка массива строк по алфавиту (в порядке возрастания)
   Dim i As Integer, j As Integer
    Dim strBuffer As String, fBuffer As Boolean
    For i = LBound(astrNames) To UBound(astrNames) - 1
        For j = i + 1 To UBound(astrNames)
            If astrNames(i) > astrNames(j) Then    ' Меняем i-й и j-й элементы массива местами
               strBuffer = astrNames(i): astrNames(i) = astrNames(j): astrNames(j) = strBuffer
            End If
        Next j
    Next i
End Sub