Tuesday, July 5, 2011

Sheet Sorter



Sort your sheets in Alphabets Order..

Sub SheetSorter()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled

Dim count As Integer
Dim ws As Worksheet
Dim oldactive As Object
Dim ws1 As Worksheet
Dim sheetName1 As String

If ActiveWorkbook.ProtectStructure = True Then
        MsgBox "Workbook is protected "
        Exit Sub
End If
Set oldactive = ActiveSheet

If ActiveWorkbook Is Nothing Then Exit Sub

Application.DisplayAlerts = False
           
            For Each ws In Worksheets
                If ws.Name = "SheetData" Then ws.Delete
            Next ws

Worksheets.Add.Name = "SheetData"
count = ActiveWorkbook.Sheets.count
Worksheets("Sheetdata").Activate
Dim i As Integer
            For i = 1 To count
                ActiveCell.value = Sheets(i).Name
                Worksheets("Sheetdata").Range("A1").Offset(i, 0).Select
            Next i

Cells.Sort key1:=Range("A1")
Worksheets("Sheetdata").Activate
Worksheets("Sheetdata").Range("A1").Select
               
                For i = 1 To count
                        Worksheets(ActiveCell.value).Move _
                        before:=Worksheets("SheetData")
                        Worksheets("Sheetdata").Activate
                        Range("A1").Offset(i, 0).Activate
                Next i
               
Worksheets("Sheetdata").Delete
oldactive.Activate
Application.ScreenUpdating = True
End Sub

No comments: