Macro sur fonction tri

Option Explicit
Sub CreerRapports()
Dim wbk As Workbook
Dim wsh As Worksheet
Dim rng As Range
Dim crt As Range
Dim dic As Object
Dim tbl As Variant
Dim ste As Variant
Dim nom As String
Dim i As Long
  
  ' Définir la plage des données
  Set rng = ThisWorkbook.Worksheets(1).Range("A9").CurrentRegion
  ' Lister les sociétés (dans dic)
  Set dic = CreateObject("scripting.dictionary")
  tbl = rng.Offset(1).Resize(rng.Rows.Count - 1, 1).Value
  For i = 1 To UBound(tbl): dic(tbl(i, 1)) = "": Next i
  Erase tbl: tbl = Empty
  ' Pour chaque société :
  For Each ste In dic.keys
    ' - mettre à jour les critères du filtre élaboré
    ThisWorkbook.Worksheets(2).Range("A2").Value = ste
    ' - créer le rapport (avec 3 feuilles)
    Set wbk = Workbooks.Add(xlWBATWorksheet)
    wbk.Worksheets.Add Count:=2
    ' - mettre à jour la feuille FCL
    Set wsh = wbk.Worksheets(1)
    With wsh
      .Name = "Sts FCL"
      ' -- filter les données à transférer
      Set crt = ThisWorkbook.Worksheets(2).Range("A1").CurrentRegion
      rng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=crt, Unique:=False
      ' -- copier les données
      rng.Copy Destination:=.Range("A1")
      If rng.Parent.FilterMode Then rng.Parent.ShowAllData
    End With
    ' - mettre à jour la feuille MTY
    Set wsh = wbk.Worksheets(2)
    With wsh
      .Name = "STS MTY"
      ' -- filter les données à transférer
      Set crt = ThisWorkbook.Worksheets(2).Range("A4").CurrentRegion
      rng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=crt, Unique:=False
      ' -- copier les données
      rng.Copy Destination:=.Range("A1")
      If rng.Parent.FilterMode Then rng.Parent.ShowAllData
    End With
    ' - mettre à jour la feuille REEFER
    Set wsh = wbk.Worksheets(3)
    With wsh
      .Name = "REEFER TEMP C"
      ' -- filter les données à transférer
      Set crt = ThisWorkbook.Worksheets(2).Range("A7").CurrentRegion
      rng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=crt, Unique:=False
      ' -- copier les données
      rng.Copy Destination:=.Range("A1")
      If rng.Parent.FilterMode Then rng.Parent.ShowAllData
    End With
    ' - enregistrer et fermer le rapport
    nom = ThisWorkbook.Path & "\" & Format(Date, "yyyy-mm-dd") & " Rapport " & ste
    wbk.SaveAs nom
    wbk.Close False
  Next ste
End Sub

      '....
      If rng.Parent.FilterMode Then rng.Parent.ShowAllData
      .Columns.AutoFit
    End With