Como reorganizo as folhas em ordem específica e depois alfabeticamente?

Question

Eu preciso reordenar minhas planilhas em uma ordem específica, então, se houver alguma, escreva em ordem alfabética. Eu tenho a macro abaixo para reorganizá-los em ordem alfabética.

Se eu tiver folhas "" METALS "," SVOC "," GENCHEM ", etc .-- Eu quero que eles estejam sempre em ordem alfabética. ENTÃO quaisquer outras folhas" Apple "," zebra "," Leão "devem vem depois em ordem alfabética.

Eu tentei esse código, mas não deu certo

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)

'------- Minha macro de trabalho abaixo ----

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

    

Answer 1

Eu meio que refiz o código. Isso funciona para mim. Note que tipo de "Brute Force" as folhas especiais que você precisa no começo, usando um array.

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