Benten667
The main problem with your code is that you are referencing a ListObject that is not there. Neither sheet contains a table (ListObject).
Like nilem, but I add a custom list temporarily.
Private Sub CommandButton1_Click()
    Dim Ws          As Worksheet
    Dim Rng         As Range
    Dim lLstCnt     As Long


    Application.AddCustomList listArray:=Split("1-0-0,1-1-0,1-1-1,1-1-2,1-1-3,1-1-4,1-2-0,1-2-1,1-2-2,1-2-3,1-2-4," & _
                                               "1-3-0,1-3-1,1-3-2,1-3-3,1-3-4,1-4-0,1-4-1,1-4-2,1-4-3,1-4-4," & _
                                               "1-5-0,1-5-1,1-5-2,1-5-3,1-5-4,1-6-0,1-6-1,1-6-2,1-6-3,1-6-4," & _
                                               "1-7-0,1-7-1,1-7-2,1-7-3,1-7-4,1-8-0,2-0-0,3-0-0," & _
                                               "2-1-0,2-1-1,2-1-2,2-1-3,3-1-1,3-1-2,3-1-3,3-1-4,2-2-0,2-2-1,2-2-2,2-2-3," & _
                                               "3-2-1,3-2-2,3-2-3,3-2-4,2-3-0,2-3-1,2-3-2,2-3-3,3-3-1,3-3-2,3-3-3,3-3-4," & _
                                               "2-4-0,2-4-1,2-4-2,2-4-3,3-4-1,3-4-2,3-4-3,3-4-4,2-5-0,2-5-1,2-5-2,2-5-3," & _
                                               "3-5-1,3-5-2,3-5-3,3-5-4,3-6-1,3-6-2,3-6-3,3-6-4,2-6-0,2-6-1,2-6-2,2-6-3," & _
                                               "3-7-1,3-7-2,3-7-3,3-7-4,3-8-1,3-8-2,3-8-3,3-8-4,2-7-0,2-7-1,2-7-2,2-7-3,2-8-0," & _
                                               "5-1-0,5-2-0,5-3-0,4-1-0,4-2-0,4-3-0,4-4-0,5-4-0,5-5-0,4-5-0,4-6-0," & _
                                               "5-6-0,5-6-1,5-7-0,4-7-0,4-8-0,5-8-0,5-8-1,5-9-0,4-9-0,4-10-0,5-10-0,5-11-0," & _
                                               "6-1-0,6-2-0,6-3-0,6-4-0,6-5-0,6-6-0,6-7-0,6-8-0,6-9-0,6-10-0,6-11-0,0," & _
                                               "Sur chaîne,A determiner,Servantes visserie", ",")

    lLstCnt = Application.CustomListCount

    'On Error Resume Next
    For Each Ws In Worksheets
        If UCase(Ws.Name) <> "CONFIG" Then
            With Ws
                Set Rng = .Range("D3").CurrentRegion
                With .Sort
                    .SortFields.Clear
                    .SortFields.Add Key:=Rng.Columns(2), _
                                    SortOn:=xlSortOnValues, _
                                    Order:=xlAscending, _
                                    CustomOrder:=lLstCnt, _
                                    DataOption:=xlSortNormal
                    .SetRange Rng
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End With
        End If
    Next Ws

    Application.DeleteCustomList ListNum:=lLstCnt
    ActiveCell.Activate

End Sub
Artik