Alphabetizing The Worksheets

[fdegree]

As you all know, when you open a workbook, there are tabs in the lower left corner that show the names of each worksheet within that workbook. My question is…How can I sort these worksheets (tabs) into alphabetical order?


Thanks...

 

[arthurbr]

Hi,
you'll find a solution at http://www.cpearson.com/excel/sortws.aspx

Cheers

 

[Lewiy]

Try this macro:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

<o:p></o:p>

Sub SortTabs()<o:p></o:p>
Dim CheckStr1 As String, CheckStr2 As String<o:p></o:p>
Dim sh As Worksheet<o:p></o:p>
Dim SheetNames() As String<o:p></o:p>
Dim NoOfSheets As Long<o:p></o:p>
Dim c As Long, d As Long<o:p></o:p>
Dim Anyswaps As Boolean<o:p></o:p>
NoOfSheets = ThisWorkbook.Sheets.Count<o:p></o:p>
ReDim SheetNames(NoOfSheets)<o:p></o:p>
If NoOfSheets > 1 Then<o:p></o:p>
    c = 1<o:p></o:p>
    For Each sh In ThisWorkbook.Worksheets<o:p></o:p>
        SheetNames(c) = sh.Name<o:p></o:p>
        c = c + 1<o:p></o:p>
    Next sh<o:p></o:p>
    Do<o:p></o:p>
        Anyswaps = False<o:p></o:p>
        For c = 1 To NoOfSheets - 1<o:p></o:p>
            If SheetNames(c) > SheetNames(c + 1) Then<o:p></o:p>
                SheetNames(0) = SheetNames(c)<o:p></o:p>
                SheetNames(c) = SheetNames(c + 1)<o:p></o:p>
                SheetNames(c + 1) = SheetNames(0)<o:p></o:p>
                Anyswaps = True<o:p></o:p>
            End If<o:p></o:p>
        Next c<o:p></o:p>
    Loop Until Anyswaps = False<o:p></o:p>
    For d = 1 To NoOfSheets<o:p></o:p>
        For c = NoOfSheets To 2 Step -1<o:p></o:p>
            Sheets(SheetNames(c)).Move after:=Sheets(SheetNames(c - 1))<o:p></o:p>
        Next c<o:p></o:p>
    Next d<o:p></o:p>
End If<o:p></o:p>
End Sub<o:p></o:p>

<o></o>

 

[schielrn]

This should work also:

Sub sortWS()
Dim ws As Worksheet
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
    For i = 1 To Sheets.Count - 1
        ws.Cells(i, 1).Value = Sheets(i).Name
    Next i
    ws.Range("A1:A" & Sheets.Count - 1).Sort key1:=Range("A1")
    For i = 1 To Sheets.Count - 1
        Sheets(ws.Cells(i, 1).Value).Move Before:=Sheets(i)
    Next i
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub

 

[fdegree]

Thank you everyone...it's working great.

Kind of interesting how there is more than 1 approach to solving these issues. At least it is interesting to me...I don't know anything about it.