select unique values range to column

Sub SelectUniqueValues()
    Dim sn, lngRow As Long, lngCol As Long
    sn = Range("A4:F40")
    With CreateObject("Scripting.Dictionary")
        For lngRow = 1 To UBound(sn, 1)
            For lngCol = 1 To UBound(sn, 2)
                If sn(lngRow, lngCol) <> "" Then x0 = .Item(sn(lngRow, lngCol))
            Next
        Next
        Range("K4:K" & .Count + 3) = Application.Transpose(.keys)
    End With
End Sub