XL 2013 VBA / Extraction des 10 plus petites valeurs d'un tableau structuré

'-------------------------------------------------------------
'Extraction des 10 premiers éléments du Tableau1 en tableau P6
'-------------------------------------------------------------
Sub Extraction()
    Dim i As Integer

    'Inhibe l'affichage
    Application.ScreenUpdating = False

    'Tri du Tableau1 sur la colonne Rang
    ActiveSheet.Range("Tableau1").Sort key1:=ActiveSheet.Range("Tableau1[Colonne9]"), Header:=xlNo, Order1:=xlAscending

    'Pour les éventuels 10 premiers éléments du Tableau1
    For i = 1 To 10
        'Remise à blanc de la ligne du tableau P6
        ActiveSheet.Range("P6").Offset(i - 1, 0).Resize(1, 4).ClearContents
    
        'Si le Tableau1 a au moins i lignes
        If ActiveSheet.Range("Tableau1").Rows.Count >= i Then
        
            'Si le Rang est non nul
            If ActiveSheet.Range("Tableau1[Colonne9]").Cells(i).Value > 0 Then
        
                'Valoriser le Rang dans la ligne du tableau P6
                ActiveSheet.Range("P6").Offset(i - 1, 0).Value = i
            
                'Copier 3 cellules à partir de la 3ème du Tableau1 dans la ligne du tableau P6
                ActiveSheet.Range("Tableau1").Rows(i).Cells(3).Resize(1, 3).Copy _
                    Destination:=ActiveSheet.Range("P6").Offset(i - 1, 1)
            End If
        End If
    Next i

    'Tri du Tableau1 sur la colonne Date d'entrée
    Range("Tableau1").Sort key1:=Range("Tableau1" & "[Colonne2]"), Header:=xlNo, Order1:=xlAscending

    'Désinhibe l'affichage
    Application.ScreenUpdating = True

    MsgBox "Extraction terminée !"
End Sub