Sort Worksheets from sheet 4

[micko1]

Is it possible to sort all sheets in alphabetical order but leave the first 3 sheets as they are. I have a workbook with 200 or more worksheets. The first 3 sheets need to stay where they are but all sheets from there (Sheet 4 ) to the end need to be sorted. This is the code I have that sorts all sheets. Can it be adjusted to do what I want.
Thanks in anticipation.

Mick


Sub SortWorksheets()
' sort worksheets in a workbook in ascending order
Dim sCount As Integer, i As Integer, j As Integer
Application.ScreenUpdating = False
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
End Sub

 

[CWatts]

At the end of the loops, before the sub ends, you can just manually pop them back in the first 3 spots:

Sheets("Sheet4").Move Before:=Sheets(1)
Sheets("Sheet5").Move Before:=Sheets(2)
Sheets("Sheet6").Move Before:=Sheets(3)

 

[Nalani]

Try this on a copy to see if it gives what you want.

Sub SortWorksheets()
Dim N As Integer
Dim M As Integer
Dim FirstWSToSort As Integer
Dim LastWSToSort As Integer
Dim SortDescending As Boolean
With Application
    .ScreenUpdating = False
End With
SortDescending = False
If ActiveWindow.SelectedSheets.Count = 1 Then
    FirstWSToSort = 4
    LastWSToSort = Worksheets.Count
Else
    With ActiveWindow.SelectedSheets
        For N = 2 To .Count
            If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                MsgBox "You cannot sort non-adjacent sheets"
                Exit Sub
            End If
        Next N
        FirstWSToSort = .Item(1).Index
        LastWSToSort = .Item(.Count).Index
     End With
End If
For M = FirstWSToSort To LastWSToSort
    For N = M To LastWSToSort
        If SortDescending = True Then
            If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                Worksheets(N).Move Before:=Worksheets(M)
            End If
        Else
            If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
               Worksheets(N).Move Before:=Worksheets(M)
            End If
        End If
     Next N
Next M
With Application
    .ScreenUpdating = True
End With
End Sub

 

[micko1]

Nalani

Code works great, thanks very much for your assistance.

Mick

 

[Nalani]

Glad I could help

Thanks for the feed back