Sortering af arkfaner

Et ofte stillet spørgsmål omkring Excel er, om det er muligt at sortere arkfanerne? Det er der ingen umiddelbar mulighed for at gøre. Her er en funktion, der sortere arkene alfabetisk, efter først at have spurgt om der skal sorteres i stigende eller faldende orden.

Sub SorterAlfa()
    Dim SortRkf As Byte
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet

    SortRkf = MsgBox("Klik Ja for at sortere i stigende orden?" & _
        vbCrLf & "Klik nej for at sortere i faldende" & _
        vbcrlf & "Klik Annuller for at undlade at sortere", _
        vbYesNoCancel + vbQuestion)
        Application.ScreenUpdating = False

    If SortRkf = vbYes Then

        For Each sh1 In Worksheets
            For Each sh2 In Worksheets
                If sh1.Name > sh2.Name Then
                    sh2.Move sh1
                End If
            Next sh2
        Next sh1

    ElseIf SortRkf = vbNo Then

        For Each sh1 In Worksheets
            For Each sh2 In Worksheets
                If sh1.Name < sh2.Name Then
                    sh2.Move sh1
                End If
            Next sh2
    Next sh1

    Else
        Exit Sub
    End If

Application.ScreenUpdating = True

End Sub

Er arknavnene tal, og der ønskes sorteret i numerisk orden i stedet for alfabetisk, kan følgende anvendes.

Sub SorterNum()
    Dim SortRkf As Byte
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet

    On Error GoTo Fejl

    SortRkf = MsgBox("Klik Ja for at sortere i stigende orden?" & _
        vbCrLf & "Klik nej for at sortere i faldende" & _
        vbCrLf & "Klik Annuller for at undlade at sortere", _
        vbYesNoCancel + vbQuestion)

    Application.ScreenUpdating = False

    If SortRkf = vbYes Then

        For Each sh1 In Worksheets
            For Each sh2 In Worksheets
                If CInt(sh1.Name) > CInt(sh2.Name) Then
                    sh2.Move sh1
                End If
            Next sh2
        Next sh1

    ElseIf SortRkf = vbNo Then

        For Each sh1 In Worksheets
            For Each sh2 In Worksheets
                If CInt(sh1.Name) < CInt(sh2.Name) Then
                    sh2.Move sh1
                End If
            Next sh2
        Next sh1

    Else
        Exit Sub
    End If

    Exit Sub

Fejl:
    If Err.Number = 13 Then
    Ans = MsgBox("Denne funktion virker kun, hvis alle arknavne er numeriske" _
        & vbCrLf & "Ønsker du i stedet at sortere alfabetisk?" _
,       vbYesNo + vbExclamation)

        If Ans = vbYes Then
            Call SorterAlfa
        Else
            Exit Sub
        End If
    End If

    Application.ScreenUpdating = True

End Sub

NB! begge makroer skal være i samme modul.

- Tilbage til makroer -
- Tilbage til Excel -