Option Explicit
Sub transform()
Dim rng As Range
Dim RowNo As Integer
Dim ColNo As Integer
Dim arrJob() As String
ReDim arrJob(0)
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
For ColNo = 1 To 3
For RowNo = 2 To rng.Rows.Count
Call InsertJob(rng.Cells(RowNo, ColNo), arrJob)
Next RowNo
Next ColNo
For ColNo = 1 To UBound(arrJob)
ThisWorkbook.Worksheets("Sheet2").Cells(2, ColNo) = arrJob(ColNo)
Next
End Sub
Function InsertJob(Job As String, arrJob() As String)
Dim I As Integer
If Len(Trim(Job)) = 0 Then
Exit Function
End If
For I = 1 To UBound(arrJob)
If Job = arrJob(I) Then
Exit Function
End If
Next I
ReDim Preserve arrJob(I)
arrJob(I) = Trim(Job)
Call Sort(arrJob)
End Function
Function Sort(arrJob() As String)
Dim I As Integer
Dim Temp As String
For I = UBound(arrJob) To 2 Step -1
If arrJob(I - 1) > arrJob(I) Then
Temp = arrJob(I - 1)
arrJob(I - 1) = arrJob(I)
arrJob(I) = Temp
Else
Exit Function
End If
Next I
End Function