trier des feuilles

Option Explicit

Sub SheetsSort()
'Michel Pierron, mpfe
Dim id As Byte, no As Byte, ValNom(1) As Byte
Dim StrNom(1) As String

no = 1
Application.ScreenUpdating = False
Do While no no
        If IsAlphaNum(Sheets(id).Name) And IsAlphaNum(Sheets(id - 1).Name) Then
            StrNom(0) = Left(Sheets(id).Name, Len(Sheets(id).Name) - iPos(Sheets(id).Name))
            ValNom(0) = Mid(Sheets(id).Name, Len(StrNom(0)) + 1)
            StrNom(1) = Left(Sheets(id - 1).Name, Len(Sheets(id - 1).Name) - iPos(Sheets(id - 1).Name))
            ValNom(1) = Mid(Sheets(id - 1).Name, Len(StrNom(1)) + 1)
       
            Select Case StrComp(StrNom(0), StrNom(1), 1)
              Case -1
                  Sheets(id).Move Before:=Sheets(id - 1)
              Case 0
                If ValNom(0) < ValNom(1) Then Sheets(id).Move Before:=Sheets(id - 1)
            End Select
        Else
            If StrComp(Sheets(id).Name, Sheets(id - 1).Name, 1) = -1 Then
            Sheets(id).Move Before:=Sheets(id - 1)
            End If
        End If
   
    id = id - 1
    Loop
no = no + 1
Loop
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

Private Function IsAlphaNum(NameSheet As String) As Boolean
    IsAlphaNum = Not IsNumeric(NameSheet) And IsNumeric(Right(NameSheet, 1))
End Function

Private Function iPos(NameSheet As String) As Byte
    iPos = 0
            Do While IsNumeric(Right(NameSheet, iPos + 1))
                iPos = iPos + 1
            Loop
End Function

Cliquez pour agrandir...