Option Explicit
Sub X()
' constants
Const ksWSI = "Sheet1"
Const ksInput = "LabelInputList"
Const ksWSO = "Sheet1"
Const ksOutput = "LabelOutputList"
Const ksSeparator = "-"
Const ksExclude = "N°"
' declarations
Dim rngI As Range, rngO As Range
Dim I As Integer, J As Integer, K As Integer, A As String, bOk As Boolean
Dim sOutput As String, iAll As Integer, sArrayAux() As String, sArrayAll() As String
' start
Set rngI = Worksheets(ksWSI).Range(ksInput)
Set rngO = Worksheets(ksWSO).Range(ksOutput)
' process
With Worksheets(ksWSI)
For J = 1 To rngI.Columns.Count
' build list
iAll = 0
I = 1
sOutput = ""
ReDim sArrayAll(0)
Do Until .Cells(rngI.Row + I, rngI.Column + J - 1).Value = ""
A = .Cells(rngI.Row + I, rngI.Column + J - 1).Value
sArrayAux = Split(A)
For K = 0 To UBound(sArrayAux)
iAll = iAll + 1
ReDim Preserve sArrayAll(UBound(sArrayAll) + 1)
sArrayAll(iAll) = sArrayAux(K)
Next K
I = I + 1
Loop
' sort list
For I = 1 To iAll - 1
For K = I + 1 To iAll
bOk = False
If Val(sArrayAll(I)) > 0 And Val(sArrayAll(K)) > 0 Then
If Val(sArrayAll(I)) > Val(sArrayAll(K)) Then
bOk = True
Else
bOk = False
End If
Else
If sArrayAll(I) > sArrayAll(K) Then
bOk = True
Else
bOk = False
End If
End If
If bOk Then
A = sArrayAll(I)
sArrayAll(I) = sArrayAll(K)
sArrayAll(K) = A
End If
Next K
Next I
' final list
sOutput = ""
K = 0
For I = 1 To iAll
bOk = False
If sArrayAll(I) <> ksExclude Then
If I = 1 Then
bOk = True
Else
If sArrayAll(I) <> sArrayAll(I - 1) Then bOk = True
End If
End If
If bOk Then
K = K + 1
If K <> 1 Then sOutput = sOutput & ksSeparator
sOutput = sOutput & sArrayAll(I)
End If
Next I
.Cells(rngO.Row + J - 1, rngO.Column + 1).Value = sOutput
Next J
End With
' end
Set rngO = Nothing
Set rngI = Nothing
End Sub