ordenar dependiendo de columna

[dragonfire33]

hola buenos dias , tengo varios datos numericos entre el rango "z1:tw42" y me gustaria hacer lo siguiente:
1. mediante un mensaje decir "que fila desea ordenar" ya que son 42 filas y
2. otro mensaje " en que columna desea colocar los datos"
la idea es que no sea seleccionado

Sub Transponer_Ordenado()



Dim Seleccion As Range, rang As Range, mat, i As Long
Dim cont As Long, n As Range, vca As Range
Dim fi As Double, co As Double

fi = Application.InputBox("¿Que fila desea ordenar?", "Fila ordenar", , , , , , 1)
irco:
co = Application.InputBox("¿En que columna desea mostrar?", "Columna ordenar", , , , , , 1)

If fi = 0 Or co = 0 Then Exit Sub

If co > 25 Then GoTo irco:

Set Seleccion = Range("Z" & fi & ":TW" & fi)

Application.ScreenUpdating = False

On Error GoTo error1:

Set rang = Seleccion.SpecialCells(2, 1)
cont = rang.Count

If cont > 1 Then

    'On Error Resume Next
    Columns(co).ClearContents
    'On Error GoTo 0
    
    ReDim mat(1 To cont)
    
    For Each n In rang
        i = i + 1: mat(i) = n
    Next
    
    Cells(2, co).Resize(cont) = Application.Transpose(mat)
    With Cells(1, co)
        .Value = "Num"
        .Sort .Cells, 1, , , , , , 1
        .EntireColumn.AutoFit
    End With
    
    rang.Select
    
    Application.ScreenUpdating = True
    
    VBA.MsgBox "Total valores ordenados: " & cont, vbInformation, "Ordenados"
    
    GoTo ir:
Else
    GoTo ira:
End If

ira:
VBA.MsgBox "Debe seleccionar mas valores", vbCritical, "Seleccion"

ir:
Set rang = Nothing: Set Seleccion = Nothing
Exit Sub

error1:
VBA.MsgBox Err.Description, vbCritical, "GP"

End Sub

 

[DanteAmor]

Prueba esto:

Sub Transponer_Ordenado()
  Dim fi As Long, co As Long
  
  With Application
    .ScreenUpdating = False
    fi = .InputBox("¿Que fila desea ordenar?", "Fila ordenar", , , , , , 1)
irco:
    co = .InputBox("¿En que columna desea mostrar?", "Columna ordenar", , , , , , 1)
    If fi = 0 Or co = 0 Then Exit Sub
    If co > 25 Then GoTo irco:
    Columns(co).ClearContents
  End With
  
  On Error GoTo error1:
  With Range("Z" & fi & ":TW" & fi).SpecialCells(xlCellTypeConstants, 1)
    If .Count > 0 Then
      .Copy
      With Cells(1, co)
        .Offset(1).PasteSpecial xlPasteValues, , , True
        .Value = "Num"
        Range(.Address, Cells(Rows.Count, co).End(3)).Sort .Cells(1), 1, , , , , , 1
        .EntireColumn.AutoFit
      End With
    End If
  End With
  
  Exit Sub
error1:
  VBA.MsgBox Err.Description, vbCritical, "GP"
End Sub