Hallo,

ich möchte die Auswahlliste alphanumerisch sortieren. Die Daten stammen aus einem anderen Tabellenblatt und werden mit Hilfe eines Makros ausgewertet bzw. übergeben. Habt Ihr eine Idee, wie ich das Makro verändern muss, damit die Auswahlliste sortiert ausgegeben wird?

Sub auto_open()

Überprüfen
    Sheets("Projekte").Select

Dim I As Integer
Dim werte As String
Dim ws_count As Integer
Dim j As Integer

' Ermitteln der gültigen Projekte
Application.ScreenUpdating = False

ActiveWorkbook.Sheets("Projekte").Select
I = 4
werte = ""
While ActiveWorkbook.ActiveSheet.Range("A" & I).Value <> "" And ActiveWorkbook.ActiveSheet.Range("A" & I).Value <> Leer
    If ActiveWorkbook.ActiveSheet.Range("S" & I).Value = "Projekt buchbar" Then
        ' in Liste aufnehmen
        If I = 4 Then
            werte = ActiveWorkbook.ActiveSheet.Range("A" & I).Value
        Else
            werte = werte & "," & ActiveWorkbook.ActiveSheet.Range("A" & I).Value
        End If
    End If
    I = I + 1
Wend

If werte = "" Or werte = Leer Then
    ' keine gültigen Projekte gefunden, Gültigkeit würde mit leerem Feld abbrechen, deswegen ist hier Ende
    Application.ScreenUpdating = True
    Exit Sub
Else

    ' Set WS_Count equal to the number of worksheets in the active
    ws_count = ActiveWorkbook.Worksheets.Count
    ' Begin the loop.
    For j = 1 To ws_count
        If ActiveWorkbook.Worksheets(j).Name = "Projekte" Then
        Else

            ' Gültigkeit für Auswahl der Projekte festlegen
            'ActiveWorkbook.Sheets("Mustermann").Select
            ActiveWorkbook.Worksheets(j).Select
            ActiveWorkbook.ActiveSheet.Range("B3:B10000").Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=werte
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = "Ungültiges Projekt"
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
        
    Next j
        
End If

Application.ScreenUpdating = True

End Sub
Sub Gehe_Projekte()
    Sheets("Projekte").Select

End Sub