Tri de A à Z en VBA

Bonjour à tous,

J'ai une macro me permettant de remplis un tableau organisé selon différents services et je souhaiterai ajouter un tri de A à Z sur la colonne nommée "localisation".

Le document Excel est confidentiel, cependant je vous joint le code en ésperant que vous saurez m'aider.

La plage à trier se trouve en F2:O600 (F3:O600 sans l'entête).

Du coup j'ai un peu avancé et j'air réussi à sortir une formule de tri avec l'enregistreur, cependant, il faudrait que les services restent dans l'ordre alors qu'ils se mélangent pour le moment puisque la localisation prend le dessus.

J'ai trouvé comment autoriser le filtre selon les services donc plus besoin de priorité, cependant, à l'ouverture du classeur, Excel me dit qu'il y a un contenu illisible... Lorsque je lui dit que le doc est fiable il me dit :

Enregistrements supprimés: Tri dans la partie /xl/worksheets/sheet2.xml

Si quelqu'un sait comment résoudre le problème je suis preneur.

Dim sce, ln, lgn, i, col

Sub Synthétiser()

ActiveSheet.Unprotect

    Range("F3").CurrentRegion.Offset(1, 0).ClearContents

    ln = 7
    While Cells(ln, "A") <> ""
        If Range("A" & ln) = "BAR PLAGE/0011" Or Range("A" & ln) = "Mini Bar" _
                Or Range("A" & ln) = "PALME D OR/0011" Or Range("A" & ln) = "RELAIS MARTINEZ/0011" _
                Or Range("A" & ln) = "RESTAURANT PLAGE/0011" Or Range("A" & ln) = "Room Service" Then
            sce = Range("A" & ln)
            i = 0
        Else
            i = i + 1
            col = i Mod 3
            lgn = Range("F" & Rows.Count).End(xlUp)(2).Row
            Range("F" & lgn) = Worksheets("MyMicrosDD").Range("B2")
            Range("G" & lgn) = sce
            Range("I" & lgn) = Range("A" & ln + 1)
            Range("J" & lgn) = Range("A" & ln)
            Range("O" & lgn) = Range("A" & ln).Offset(0, 1)
            Range("R" & lgn) = Range("A" & ln).Offset(0, 1)
            ln = ln + 1
        End If
        ln = ln + 1
    Wend

    For i = 3 To Range("O" & Rows.Count).End(xlUp).Row
        If Range("I" & i) = "" Or Range("L" & i) = "" Then
            Range("O" & i).ClearContents
        End If
    Next i

    ActiveWorkbook.Worksheets("MyMicrosDD").AutoFilter.Sort.SortFields.Add Key:= _
        Range("K2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MyMicrosDD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveSheet.Protect AllowFiltering:=True

    MsgBox "Quantités mises à jour"
End Sub

Par avance merci.

Re,

J'ai fini par trouver la solution, le filtre masquant certaines valeurs, la macro ne pouvait pas fonctionner correctement, l'ajout d'un

ActiveSheet.ShowAllData

m'a permit de résoudre le problème.

Je vous joint le code final si quelqu'un rencontre le même soucis à l'avenir.

Dim sce, ln, lgn, i, col

Sub Synthétiser()

ActiveSheet.Unprotect
ActiveSheet.ShowAllData

    Range("F3").CurrentRegion.Offset(1, 0).ClearContents

    ln = 7
    While Cells(ln, "A") <> ""
        If Range("A" & ln) = "BAR PLAGE/0011" Or Range("A" & ln) = "Mini Bar" _
                Or Range("A" & ln) = "PALME D OR/0011" Or Range("A" & ln) = "RELAIS MARTINEZ/0011" _
                Or Range("A" & ln) = "RESTAURANT PLAGE/0011" Or Range("A" & ln) = "Room Service" Then
            sce = Range("A" & ln)
            i = 0
        Else
            i = i + 1
            col = i Mod 3
            lgn = Range("F" & Rows.Count).End(xlUp)(2).Row
            Range("F" & lgn) = Worksheets("MyMicrosDD").Range("B2")
            Range("G" & lgn) = sce
            Range("I" & lgn) = Range("A" & ln + 1)
            Range("J" & lgn) = Range("A" & ln)
            Range("O" & lgn) = Range("A" & ln).Offset(0, 1)
            Range("R" & lgn) = Range("A" & ln).Offset(0, 1)
            ln = ln + 1
        End If
        ln = ln + 1
    Wend

    For i = 3 To Range("O" & Rows.Count).End(xlUp).Row
        If Range("I" & i) = "" Or Range("L" & i) = "" Then
            Range("O" & i).ClearContents
        End If
    Next i

    ActiveWorkbook.Worksheets("MyMicrosDD").AutoFilter.Sort.SortFields.Add Key:= _
        Range("K2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MyMicrosDD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveSheet.Protect AllowFiltering:=True

    MsgBox "Quantités mises à jour"
End Sub

Cordialement.