Macro to sort worksheets

[ahasija2s]

Hello!
I am trying to write a VBA macro which would sort the worksheets according to the names. For example, sheets containing the word "Termed" should be placed at the end. I have included an example. In the example, "b-termed" worksheet should be placed at the end. I don't have a lot of background in VBA macros, so any help would be great! Thanks!

Worksheet names:
a
b-termed
c
d
e
f

 

[John_w]

Try this macro:

Public Sub Sort_Sheets_In_2_Groups()

    Dim i As Long
    Dim group1Names() As String, group2Names() As String
    Dim n1 As Long, n2 As Long
    
    n1 = 0: n2 = 0
    
    With ActiveWorkbook
    
        For i = 1 To .Sheets.Count
            If InStr(1, .Sheets(i).Name, "termed", vbTextCompare) Then
                ReDim Preserve group2Names(n2)
                group2Names(n2) = .Sheets(i).Name
                n2 = n2 + 1
            Else
                ReDim Preserve group1Names(n1)
                group1Names(n1) = .Sheets(i).Name
                n1 = n1 + 1
           End If
        Next
    
        BubbleSort group1Names
        BubbleSort group2Names
    
        For i = 0 To UBound(group1Names)
            .Sheets(group1Names(i)).Move Before:=.Sheets(i + 1)
        Next
        
        For i = 0 To UBound(group2Names)
            .Sheets(group2Names(i)).Move Before:=.Sheets(UBound(group1Names) + i + 2)
        Next
    
    End With
    
End Sub


Private Sub BubbleSort(data As Variant)

    'Sort a one-dimensional string array
    
    Dim i As Long, j As Long
    Dim temp As String
    
    For i = LBound(data) To UBound(data) - 1
        For j = i + 1 To UBound(data)
            If data(i) > data(j) Then              'ascending order
                temp = data(i)
                data(i) = data(j)
                data(j) = temp
            End If
        Next
    Next
     
End Sub

 

[ahasija2s]

Thanks! I ended up doing this and it seems to do the trick:

Sub SortWorkbook()
Application.ScreenUpdating = False
Dim xResult As VbMsgBoxResult
xTitleId = "Sort Worksheets"
xResult = MsgBox("Sort Sheets according to termed groups?", vbYesCancel + vbQuestion + vbDefaultButton1, xTitleId)


For i = 1 To Application.Sheets.Count
For j = 1 To Application.Sheets.Count - 1
If Right(Trim(Application.Sheets(j).Name), 7) = "-termed" Then
Sheets(j).Move after:=Sheets(j + 1)
End If
Next j
Next i


Application.ScreenUpdating = True
End Sub