Autres Je cherche à extraire des cellules en ordre croissant et sans doublons Les colonnes de référence ne peuvent être triées.

Sub NettoyerTrierPlageParLigne()
    Dim plageSource As Range, cellDepart As Range
    Dim data As Variant, newData() As Variant
    Dim i As Long, j As Long, n As Long, k As Long
    Dim nums As Object
    Dim arr As Variant, tri() As Variant
    Dim nbRows As Long, nbCols As Long
    ' --- 1) Définir la plage source ---
    Set plageSource = Range("Data")
    data = plageSource.Value
    nbRows = UBound(data, 1)
    nbCols = UBound(data, 2)
    ReDim newData(1 To nbRows, 1 To nbCols)
    Set nums = CreateObject("Scripting.Dictionary")
    ' --- 2) Nettoyage ligne par ligne ---
    For i = 1 To nbRows
        nums.RemoveAll
        ' Extraire les nombres uniques
        For j = 1 To nbCols
            If IsNumeric(data(i, j)) And data(i, j) <> "" Then
                nums(data(i, j)) = data(i, j)
            End If
        Next j
        ' Convertir en tableau
        arr = nums.Items
        n = nums.Count
        ' Trier avec Application.Small
        If n > 0 Then
            ReDim tri(0 To n - 1)
            For k = 1 To n
                tri(k - 1) = Application.Small(arr, k)
            Next k
        Else
            ReDim tri(0 To 0)
        End If      
        ' Réécrire la ligne : nombres triés puis vides
        k = 0
        For j = 1 To nbCols
            If k <= UBound(tri) Then
                newData(i, j) = tri(k)
                k = k + 1
            Else
                newData(i, j) = ""
            End If
        Next j
    Next i
    ' --- 3) Définir la cellule de départ ---
    Set cellDepart = Range("StartRes")
    ' --- 4) Écriture du résultat ---
    cellDepart.Resize(nbRows, nbCols).Value = newData
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim plage As Range
    Set plage = Me.Range("Data")
    If Not Application.Intersect(Target, plage) Is Nothing Then
        Application.EnableEvents = False
        Call NettoyerTrierPlageParLigne
        Application.EnableEvents = True
    End If
End Sub