Microsoft 365 Trier sur colonnes disjointe sur 12 feuilles

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim nomMois As String, i As Long, xcol, ncol As Long
' nom de la feuille activée (minuscule et sans accent)
nomMois = Replace(Replace(LCase(Sh.Name), "é", "e"), "û", "u")
For i = 1 To 12   ' boucle sur chaque numéro de mois
   ' si le nom de la feuille est le nom du i ème mois (minuscule et sans accent)
   If nomMois = Replace(Replace(LCase(Format(29 * i, "mmmm")), "é", "e"), "û", "u") Then
      With Sh                                   ' avec la feuille activée
         Application.ScreenUpdating = False     ' on fige l'écran (plus rapide)
         If .FilterMode Then .ShowAllData       ' si filtre actif alors on affiche tout
         For Each xcol In Split("b e j m r u")  ' pour chaque première colonne (en lettre) des blocs à trier
            ncol = .Cells(9, xcol).Column       ' la même colonne en nombre
            .Cells(9, ncol).Resize(80, 3).Sort key1:=.Cells(9, ncol), order1:=xlAscending, _
            key2:=.Cells(9, ncol + 1), order2:=xlAscending, Header:=xlNo, MatchCase:=False      ' tri du bloc
         Next xcol
      End With
      Exit For    ' la feuille activée a été trié (son mois a été trouvé), on quitte la boucle des mois
   End If
Next i

Sub Trier(Feuille As Worksheet)

listcol = Array(2, 5, 10, 13, 18, 21) 'liste des premières colonnes de zone à trier (colonnes B , E J M R et U)
With Feuille
    For j = LBound(listcol) To UBound(listcol)
        LastLine = .Cells(.Rows.Count, listcol(j)).End(xlUp).Row
        Set ZoneATrier = .Range(.Cells(9, listcol(j)), .Cells(LastLine, listcol(j))).Resize(, 3)
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=ZoneATrier.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With .Sort
            .SetRange ZoneATrier
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Next j
End With

End Sub

Sub test()
Dim Ws As Worksheet

Application.ScreenUpdating = False
    For Each Ws In ActiveWorkbook.Sheets
        Trier Ws
    Next Ws
Application.ScreenUpdating = True
End Sub