De matriz a columna o fila con Vba (macros)

En el post anterior vimos como Power Query nos permite convertir una matriz de varias columnas a una única columna de valores.

La nota surgió de una consulta sobre como convertir una matriz de datos (un rango de Excel con varias filas y varias columnas) a un rango de una única columna. Mi lector pedía que mostrara como hacerlo con macros. En su lugar mostré como hacerlo con Power Query y ésto por dos motivos:

1. porque estoy maravillado con las posibilidades del Power Query;
2. porque es mucho más fácil aprender a usar el Power Query que aprender Vba.

Sin embargo mi lector insistía en que la tarea debía hacerse con macros. A continuación publico el código para hacer la tarea. Al activar la macro debemos seleccionar el rango de la tabla a convertir; luego la primer celda de la columna o fila y finalmente elegir si queremos transformar la tabla en fila o columna únicas.

Este video muestra el proceso

El cuaderno con los códigos (del Userform y del módulo de Vba) puede descargarse aquí.

El modelo consta de un Userform

con sus códigos

y la procedura en el módulo común

Sub table_to_column_or_row()
    Dim rngTable As Range, rngCell As Range
    Dim rngDest As Range
    Dim intIndexCount As Integer, iX As Integer
    Dim valArray()
    Dim intOption As Integer
   
   
    On Error GoTo errCancel
    Set rngTable = Application.InputBox("Seleccione el rango de la tabla", "De tabla a columna", Type:=8)
    Set rngDest = Application.InputBox("Seleccione celda de destino", "Destino", Type:=8)
    On Error GoTo 0
   
    intIndexCount = rngTable.Count
   
    ReDim valArray(intIndexCount)
   
    For iX = 1 To intIndexCount
        valArray(iX - 1) = rngTable(iX)
    Next iX
   
   
   
    ufOptions.Show
   
    With ufOptions
        If .opbColumna Then intOption = 1
        If .opbFila Then intOption = 2
    End With
    Unload ufOptions
   
   
    Application.ScreenUpdating = False
   
    Select Case intOption
        Case Is = 1
            Set rngDest = rngDest.Resize(UBound(valArray), 1)
            rngDest = Application.Transpose(valArray)
        Case Is = 2
            Set rngDest = rngDest.Resize(1, UBound(valArray))
            rngDest = valArray
    End Select
      
    Application.ScreenUpdating = True
   
    Exit Sub
   
errCancel:
Exit Sub
       
End Sub