code for sheet tab reorder

[dennisli]

Good morning,
I have some sheets named as year in such format 2000, 2001, 2008, 2007, 2005. I also have some other sheets named in letter such as Total, Payment, or in number but not four digits such as 11, 22, 32.
I need to put all these kinds of sheet with four digit number on the right side of sheet named Total, ranked from the latest year to the oldest year, such as 2008, 2007, 2005, 2001, 2000.
All other sheets should be put on the left of sheet named Total.
Any idea? Thanks lot.
Dennis

 

[Ruddles]

Maybe...

Option Explicit
'
Public Sub SheetSort()
'
  Dim ws As Worksheet
  Dim ar() As String
  Dim i As Integer
  Dim j As Integer
  Dim tmp As String
'  
  ReDim ar(1 To ThisWorkbook.Sheets.Count)
'  
[COLOR=#008000]  ' save all sheet names
[/COLOR]  i = 0
  For Each ws In ThisWorkbook.Sheets
    i = i + 1
    ar(i) = ws.Name
  Next ws
'  
[COLOR=#008000]  ' sort sheet names
[/COLOR]  For i = 1 To UBound(ar) - 1
    For j = i + 1 To UBound(ar)
      If ar(i) > ar(j) Then
        tmp = ar(i)
        ar(i) = ar(j)
        ar(j) = tmp
      End If
    Next j
  Next i
'      
[COLOR=#008000]  ' shuggle year sheets to front
[/COLOR]  For i = 1 To UBound(ar)
    If IsNumeric(ar(i)) And Len(ar(i)) = 4 Then
      ThisWorkbook.Sheets(ar(i)).Move Before:=ThisWorkbook.Sheets(1)
    End If
  Next i
'  
[COLOR=#008000]  ' move Total sheet to front
[/COLOR]  ThisWorkbook.Sheets("Total").Move Before:=ThisWorkbook.Sheets(1)
'      
[COLOR=#008000]  ' shuggle remaining sheets to front
[/COLOR]  For i = UBound(ar) To 1 Step -1
    If Not IsNumeric(ar(i)) Or Len(ar(i)) <> 4 Then
      If (ar(i)) <> "Total" Then ThisWorkbook.Sheets(ar(i)).Move Before:=ThisWorkbook.Sheets(1)
    End If
  Next i
'  
End Sub

 

[dennisli]

Thank you so much, have a good day.

 

[Ruddles]

So... does it work? Do you need any changes?