=SE.ERRORE(INDICE($B$1:$D$1;;CONFRONTA(1;$B2:$D2;0));"")&"-"&SE.ERRORE(INDICE($B$1:$D$1;;CONFRONTA(2;$B2:$D2;0));"")&"-"&SE.ERRORE(INDICE($B$1:$D$1;;CONFRONTA(3;$B2:$D2;0));"")

=SE(MAX(B2:U2)>=1;INDICE($B$1:$U$1;1;CONFRONTA(1;B2:D2;0));"")&SE(MAX(B2:D2)>=2;" - "&INDICE($B$1:$D$1;1;CONFRONTA(2;B2:D2;0));"")&SE(MAX(B2:D2)>=3;" - "&INDICE($B$1:$D$1;1;CONFRONTA(3;B2:D2;0));"")&……………..&SE(MAX(B2:D2)>=3;" - "&INDICE($B$1:$D$1;1;CONFRONTA(20;B2:D2;0));"")

Option Explicit

Sub OrdinaStringhePerMatrice()

Dim MatriceCelle As Range
Dim NumRighe As Integer, NumColonne As Integer
Dim MatriceIntestazioni()
Dim MatriceMain()
Dim Index, IndexC, IndexR As Integer
Dim FinStringa As String

On Error GoTo ERRORMSG
Set MatriceCelle = Application.InputBox(Prompt:="Selezona range di lavoro Inclusivo della Prima Riga Con Intestazioni", Type:=8)

NumRighe = MatriceCelle.Rows.Count
NumColonne = MatriceCelle.Columns.Count

' dimensiona un Vettore con le intestazioni delle Colonne Che sono le stringhe da scrivere
ReDim MatriceIntestazioni(1 To NumColonne)

' riempio il Vettore sopra dimensionato
For Index = 1 To NumColonne
    MatriceIntestazioni(Index) = MatriceCelle.Cells(1, Index)
Next Index

'Dimensiono una matrice pari a tutte le celle con i criteri di ordine
ReDim MatriceMain(2 To NumRighe, 1 To NumColonne)
' riempio la matrice sopra dimensionata mettendo nella posizione indicata dalla cella corrispondente la stringa voluta
For IndexR = 2 To NumRighe
    For IndexC = 1 To NumColonne
        If MatriceCelle.Cells(IndexR, IndexC) <> "" Then
            MatriceMain(IndexR, MatriceCelle.Cells(IndexR, IndexC).Value) = MatriceIntestazioni(IndexC)
        End If
    Next IndexC
Next IndexR

'genero la stringa da scrivere alla fine ela scrivo nella cella subito a destra

For IndexR = 2 To NumRighe
FinStringa = ""
    For IndexC = 1 To NumColonne
        FinStringa = FinStringa & MatriceMain(IndexR, IndexC)
        If Not ((IndexC = NumColonne) Or (MatriceMain(IndexR, IndexC) = "")) Then
            FinStringa = FinStringa & "-"
        End If
    Next IndexC
    If Right(FinStringa, 1) = "-" Then
        FinStringa = Left(FinStringa, Len(FinStringa) - 1)
    End If
    MatriceCelle.Cells(IndexR, NumColonne).Offset(0, 1).Formula = FinStringa
Next IndexR
Exit Sub
ERRORMSG:
MsgBox Prompt:="Selezione non Valida"
End Sub

Option Explicit

Sub OrdinaStringhePerMatrice2()
  Dim wb As Workbook
  Dim ws As Worksheet, ws2 As Worksheet
  Dim vIndex() As String
  Dim x As Long, y As Long, i As Long, n As Long
  Dim sNomi As String
  Dim rSort As Range, rFound As Range
  
  Set wb = ThisWorkbook
  Set ws = wb.Sheets(1)
 
  With ws
    x = .Range("A" & .Rows.Count).End(xlUp).Row
    y = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
    For i = 2 To x
      ReDim vIndex(1 To 1)
      For Each rFound In .Range(.Cells(i, 1), .Cells(i, y)).Cells
        If rFound <> "" Then
          ReDim Preserve vIndex(1 To n + 1)
          vIndex(n + 1) = rFound.Value
          n = n + 1
        End If
      Next rFound
      n = 0
      Call BubbleSort(vIndex)
      For n = 1 To UBound(vIndex)
        If vIndex(n) <> "" Then Set rFound = .Range(.Cells(i, 1), .Cells(i, y)).Find(vIndex(n))
        If Not rFound Is Nothing Then
          sNomi = sNomi & .Cells(1, rFound.Column) & "-"
          Set rFound = Nothing
        End If
      Next n
      .Cells(i, y + 1) = sNomi
      sNomi = ""
    Next i
  End With

  Set ws2 = Nothing
  Set ws = Nothing
  Set wb = Nothing
End Sub

Sub BubbleSort(arr)
'FONTE: h t t p://social.msdn.microsoft.com/Forums/en-US/830b42cf-8c97-4aaf _
-b34b-d860773281f7/sorting-an-array-in-vba-without-excel-function?forum=isvvba
  Dim strTemp As String
  Dim i As Long
  Dim j As Long
  Dim lngMin As Long
  Dim lngMax As Long
  lngMin = LBound(arr)
  lngMax = UBound(arr)
  For i = lngMin To lngMax - 1
    For j = i + 1 To lngMax
      If arr(i) > arr(j) Then
        strTemp = arr(i)
        arr(i) = arr(j)
        arr(j) = strTemp
      End If
    Next j
  Next i
End Sub