Auto sortering af Ark/Faner

Ja og nej. Standard er det ikke muligt. Du kan dog bruge en makro til det.

Sub SortSheets()
'  This routine sorts the sheets of the
'  active workbook in ascending order.
     
    Dim SheetNames() As String
    Dim SheetHidden() As Boolean
    Dim i As Integer
    Dim SheetCount As Integer
    Dim VisibleWins As Integer
    Dim Item As Object
    Dim OldActive As Object
   
    If ActiveWorkbook Is Nothing Then Exit Sub ' No active workbook
    SheetCount = ActiveWorkbook.Sheets.Count
   
'  Check for protected workbook structure
    If ActiveWorkbook.ProtectStructure Then
        MsgBox ActiveWorkbook.Name & " is protected.", _
          vbCritical, "Cannot Sort Sheets."
        Exit Sub
    End If

'  Disable Ctrl+Break
    Application.EnableCancelKey = xlDisabled
     
'  Get the number of sheets
    SheetCount = ActiveWorkbook.Sheets.Count
   
'  Redimension the arrays
    ReDim SheetNames(1 To SheetCount)
    ReDim SheetHidden(1 To SheetCount)

'  Store a reference to the active sheet
    Set OldActive = ActiveSheet
 
'  Fill array with sheet names
    For i = 1 To SheetCount
        SheetNames(i) = ActiveWorkbook.Sheets(i).Name
    Next i
 
'  Fill array with hidden status of sheets
    For i = 1 To SheetCount
        SheetHidden(i) = Not ActiveWorkbook.Sheets(i).Visible
'      unhide hidden sheets
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = True
    Next i
   
'  Sort the array in ascending order
    Call BubbleSort(SheetNames)
 
'  Turn off screen updating
    Application.ScreenUpdating = False
   
'  Move the sheets
    For i = 1 To SheetCount
        ActiveWorkbook.Sheets(SheetNames(i)).Move _
            before:=ActiveWorkbook.Sheets(i)
    Next i
   
 
'  Re-hide sheets
    For i = 1 To SheetCount
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = False
    Next i

'  Reactivate the original active sheet
    OldActive.Activate
End Sub



Sub BubbleSort(List() As String)
'  Sorts the List array in ascending order
    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp
 
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If List(i) > List(j) Then
                Temp = List(j)
                List(j) = List(i)
                List(i) = Temp
            End If
        Next j
    Next i
End Sub

Hej Bak tak for hurtig svar .Det virker hvis man bruger simple navne på fanerne (1,2,3,4,5)eller dato. Men hvis man har forskellige navne som (0101723,807217,500017A,1710H2356,A891127)virker det ikke fines der en macro der kan løse det?
ps. navnene er numre på arbejdstejninger
hilsen Michael

Så test lige denne her

Sub SortSheets2()
'  This routine sorts the sheets of the
'  active workbook in ascending order.
     
    Dim SheetNames() As String
    Dim SheetHidden() As Boolean
    Dim i As Integer
    Dim SheetCount As Integer
    Dim VisibleWins As Integer
    Dim Item As Object
    Dim OldActive As Object
   
    If ActiveWorkbook Is Nothing Then Exit Sub ' No active workbook
    SheetCount = ActiveWorkbook.Sheets.Count
    If SheetCount = 1 Then Exit Sub ' Only one sheet
   
'  Check for protected workbook structure
    If ActiveWorkbook.ProtectStructure Then
        MsgBox ActiveWorkbook.Name & " is protected.", _
          vbCritical, "Cannot Sort Sheets."
        Exit Sub
    End If

'  Disable Ctrl+Break
    Application.EnableCancelKey = xlDisabled
     
'  Get the number of sheets
    SheetCount = ActiveWorkbook.Sheets.Count
   
'  Redimension the arrays
    ReDim SheetNames(1 To SheetCount)
    ReDim SheetHidden(1 To SheetCount)

'  Store a reference to the active sheet
    Set OldActive = ActiveSheet
 
'  Put data on worksheet
    ThisWorkbook.Sheets("SortingSheet").Range("A:C").ClearContents
    For i = 1 To SheetCount
        With ThisWorkbook.Sheets("SortingSheet")
            .Cells(i, 1) = ActiveWorkbook.Sheets(i).Name
            .Cells(i, 2) = ParseName(ActiveWorkbook.Sheets(i).Name, 1)
            .Cells(i, 3) = ParseName(ActiveWorkbook.Sheets(i).Name, 2)
        End With
    Next i
 
'  Fill array with hidden status of sheets
    For i = 1 To SheetCount
        SheetHidden(i) = Not ActiveWorkbook.Sheets(i).Visible
'      unhide hidden sheets
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = True
    Next i
 
'  Sort the worksheet data using 2 sort keys
    ThisWorkbook.Sheets("SortingSheet").Range("A1").Sort _
    Key1:=ThisWorkbook.Sheets("SortingSheet").Range("B1"), _
    Order1:=xlAscending, _
    Key2:=ThisWorkbook.Sheets("SortingSheet").Range("C1"), _
    Order2:=xlAscending, _
    Header:=xlGuess, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom
   
'  Fill SheetNames with sorted data
    For i = 1 To SheetCount
        SheetNames(i) = ThisWorkbook.Sheets("SortingSheet").Cells(i, 1)
    Next i

'  Turn off screen updating
    Application.ScreenUpdating = False
   
'  Move the sheets
    For i = 1 To SheetCount
        ActiveWorkbook.Sheets(SheetNames(i)).Move _
            before:=ActiveWorkbook.Sheets(i)
    Next i

'  Re-hide sheets
    For i = 1 To SheetCount
        If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = False
    Next i

'  Reactivate the original active sheet
    OldActive.Activate
End Sub

Private Function ParseName(fn As String, n As Integer) As Variant
'  Get text part
    If n = 1 Then
        ParseName = ""
        For i = 1 To Len(fn)
            c = Mid(fn, i, 1)
            If Not IsNumeric(c) Then
                ParseName = ParseName & c
            Else
                Exit Function
            End If
        Next i
    End If
   
'  Get number part
    If n = 2 Then
        ParseName = ""
        For i = Len(fn) To 1 Step -1
            c = Mid(fn, i, 1)
            If IsNumeric(c) Then
                ParseName = c & ParseName
            Else
                Exit Function
            End If
        Next i
    End If
End Function

Sub BubbleSort(List())
'  Sorts the List array in ascending order
    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp
 
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If List(i) > List(j) Then
                Temp = List(j)
                List(j) = List(i)
                List(i) = Temp
            End If
        Next j
    Next i
End Sub

Hej Bak jeg får denne fejlmeddelese på den nye macro(Subscript out of range)
hilsen Michael

I hvilken linie ?

Jeg får s.. også fejl.
Gider du lige prøve denne makro, den ser ud til at køre fejlfrit.

Public Sub SortSheets()
Dim lngSheet As Long
Dim objSheet As Worksheet

Dim lngLoop As Long
Dim objLoop As Worksheet
 
For lngSheet = 2 To ThisWorkbook.Sheets.Count
  Set objSheet = ThisWorkbook.Sheets(lngSheet)
  For lngLoop = 1 To lngSheet - 1
    Set objLoop = ThisWorkbook.Sheets(lngLoop)
   
    If objSheet.Name < objLoop.Name Then
      objSheet.Move objLoop
      lngLoop = lngSheet
    End If
  Next
Next
End Sub

han er sq lidt af en haj, ham bak-dyret.
Den allerførste makro kører fint for mig, bortset fra at den sorterer alle store bogstaver før små, men det kan man jo bare tage højde for.
Den sidste kan jeg ikke få til at lave noget (synligt ihvertfald), men hvad skal man dog også med to (her taler vi om sorteringsmakroer, ikke om kvinder)
Hva' med at ryste op med nogle points til bak for hans gode arbejde.

tak for det hcars :-)
Den sidste køres rigtig godt her.
den er bygget til at ligge i den fil der skal sorteres. Kan det være det der gør det ?
hvis det er, så udskift alle ThisWorkBook med ActiveWorkBook....
så virker makroen på den fil der er aktiv og ikke kun på sin egen.

Hej Bak det virker !!!, KANON  !!!!, det er alle pointene værd
Tak for hjælpen
Hilsen Michael