Problème pour modifier une liste

Bonjour à tous,

j'utilise la fonction "Sortfield" et je voulais savoir si on pouvait modifier le CustomOrder par input Box Ou en sélectionnant une plage d'une autre feuille avec en mettant un msgbox lors de l'appel du CustomOrder ci-dessous:

Sub test()
With ActiveWorkbook.Worksheets("Feuil3").Sort
.SortFields.Add Key:=Range("A1:E1"), SortOn:=xlSortOnValues, _
CustomOrder:="Banane,Abricot,Poire,Pomme,Myrtille", DataOption:=xlSortNormal
.SetRange [A1].CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlLeftToRight
.Apply
End with
Sub

J'ai essayé ça mais ça ne respecte pas l'ordre voulu:

Sub test()

Dim Message, Title, Default, MyValue
Message = "Liste"   
Title = "Fruits"   
Default = "Banane,Abricot,Poire,Pomme,Myrtille"    
' Display message, title, and default value.
MyValue = InputBox(Message, Title, Default)

    With ActiveWorkbook.Worksheets("Feuil3").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1:E1"), SortOn:=xlSortOnValues, _
            CustomOrder:="Default", DataOption:=xlSortNormal
        .SetRange [A:A].CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .Apply
    End With
End Sub

J'obtiens ça quelque soit l'ordre de départ:

alors que je demandais ça:

Banane,Abricot,Poire,Pomme,Myrtille

et quand je mets en commentaire mon input box ça fait bien ce que je souhaite

Quelqu'un aurait une explication svp?

D'avance merci

Bonne journée

Bonsoir,
Une proposition.
Cdlt.

Option Explicit

Public Sub SortData()
Dim ws As Worksheet, Rng As Range, n As Long

    On Error GoTo errHandler

    Application.AddCustomList ListArray:=Array("Banane", "Abricot", "Poire", "Pomme", "Myrtille")
    n = Application.CustomListCount

    Set ws = ActiveWorkbook.Worksheets(1)
    Set Rng = ws.Cells(1).CurrentRegion

    With ws.Sort
        .SortFields.Add _
                Key:=Rng(1), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                CustomOrder:=Application.CustomListCount
        .SetRange Rng
        .Header = xlYes
        .Orientation = xlLeftToRight
        .Apply
        .SortFields.Clear
    End With

exitHandler:
    Application.DeleteCustomList n
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume exitHandler

End Sub

Merci Bien ça marche aussi!

par contre ce programme ne permet pas de modifier la liste automatiquement

je suis comme dans l'état initial.

Re,
Une mise à jour avec une liste (range).
A méditer.
Cdlt.

Option Explicit

Public Sub SortData()
Dim wsData As Worksheet, wsList As Worksheet
Dim rngData As Range, rngList
Dim n As Long

    On Error GoTo errHandler

    Set wsData = ActiveWorkbook.Worksheets(1)
    Set rngData = wsData.Cells(1).CurrentRegion

    Set wsList = ActiveWorkbook.Worksheets(2)
    Set rngList = wsList.Cells(1).CurrentRegion

    Application.AddCustomList ListArray:=rngList
    n = Application.CustomListCount

    With wsData.Sort
        .SortFields.Add _
                Key:=rngData(1), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                CustomOrder:=Application.CustomListCount
        .SetRange rngData
        .Header = xlYes
        .Orientation = xlLeftToRight
        .Apply
        .SortFields.Clear
    End With

exitHandler:
    Application.DeleteCustomList n
    Exit Sub
errHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume exitHandler

End Sub

C'est parfait!

Merci bien