Comment réorganiser les feuilles dans un ordre spécifique, puis par ordre alphabétique?

J'ai besoin de réorganiser mes feuilles dans un ordre spécifique, puis s'il y en a un, faites-le par ordre alphabétique. J'ai la macro ci-dessous pour les réorganiser par ordre alphabétique.

Si j'ai des feuilles "" METALS "," SVOC "," GENCHEM ", etc. – Je veux que ceux-ci soient toujours par ordre alphabétique. PUIS, toutes les autres feuilles" Apple "," zebra "," Lion "devraient venir après ordre alphabétique.

J'ai essayé ce code, mais je n'ai pas fonctionné

Sheets("GENCHEM").Move Before:=Sheets(1) Sheets("METALS").Move Before:=Sheets(2) Sheets("PCBS").Move Before:=Sheets(3) Sheets("OC_PEST").Move Before:=Sheets(4) Sheets("SVOC").Move Before:=Sheets(5) Sheets("VOC").Move Before:=Sheets(6) 

'——- Ma macro de travail ci-dessous —-

• Comment activer les clés de macro Razer BlackWidow sur Windows sans installer Razer Synapse?
• Dans Excel, j'ai collé sur un tas d'URL, mais ce ne sont pas des liens en direct: comment puis-je les convertir en masse en liens en direct?
• Copier des données à partir de plusieurs documents Word dans une feuille Excel
• Création de liens automatiques dans OpenOffice
• Comment puis-je utiliser mon macbook en niveaux de gris?

 Option Explicit Sub reordersheets() '---Reorders the Sheets--- Dim N As Integer Dim M As Integer Dim FirstWSToSort As Integer Dim LastWSToSort As Integer Dim SortDescending As Boolean SortDescending = False If ActiveWindow.SelectedSheets.Count = 1 Then FirstWSToSort = 1 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 End Sub 

• Trouver et remplacer {0,} occurrences dans Word
• Hack pour exécuter plusieurs iMacros de manière aléatoire
• Comment supprimer l'extension du noyau OSx
• Remplacer <b> … </ b> avec gras en MS Word avec des macros
• VirtualBox exécutant Ubuntu est lent (hôte Mac OS X)

 Option Base 1 Sub t() Dim shtArray() As String Dim i As Long, k As Long Dim ws As Worksheet Dim R As Range Dim n As Long ' Let's "brute force" your specific sheets to the front Dim exceptionSheets() As Variant exceptionSheets = Array("GENCHEM", "METALS", "OC_PEST", "PCBS", "SVOC", "VOC") For i = 1 To ActiveWorkbook.Sheets.Count If Not UBound(Filter(exceptionSheets, ActiveWorkbook.Sheets(i).Name)) > -1 Then k = k + 1 Debug.Print Sheets(i).Name ReDim Preserve shtArray(k) shtArray(k) = ActiveWorkbook.Sheets(i).Name End If Next i Application.ScreenUpdating = False ' Thanks to http://www.cpearson.com/excel/SortingArrays.aspx ' create a new sheet Set ws = ThisWorkbook.Worksheets.Add ' put the array values on the worksheet Set R = ws.Range("A1").Resize(UBound(shtArray) - LBound(shtArray) + 1, 1) R = Application.Transpose(shtArray) ' sort the range R.Sort key1:=R, order1:=xlAscending, MatchCase:=False ' load the worksheet values back into the array For n = 1 To R.Rows.Count shtArray(n) = R(n, 1) Next n ' delete the temporary sheet Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True ' Now, sort the sheets. For i = UBound(exceptionSheets) To 1 Step -1 Sheets(exceptionSheets(i)).Move after:=Sheets(1) Next i For i = UBound(shtArray) To LBound(shtArray) Step -1 Sheets(shtArray(i)).Move after:=Sheets(7 + i - 1) Next i End Sub