Sub AlphabetizeWorksheets()
Dim bSorted As Boolean
Dim nSheetsSorted As Integer
Dim nSheets As Integer
Dim n As Integer
Dim wb As Workbook
Set wb = ActiveWorkbook
nSheets = wb.Worksheets.Count
nSheetsSorted = 0
Do While (nSheetsSorted < nSheets) And Not bSorted
bSorted = True
nSheetsSorted = nSheetsSorted + 1
For n = 1 To nSheets - nSheetsSorted
If StrComp(wb.Worksheets(n).name, wb.Worksheets(n + 1).name, vbTextCompare) > 0 Then
wb.Worksheets(n + 1).Move _
before:=wb.Worksheets(n)
bSorted = False
End If
Next
Loop
End Sub