0

Buenas tardes, estoy intentando hacer un código para que cogiendo todos los datos de una columna, me los convierta en varias filas, es decir, en la columna tengo Nombre1, apellidos1, telefono1, Nombre2, apellidos2, telefono2, ... y quiero que cada registro me lo muestre en una fila:

Sub make_matrix()
    Dim Arr_1()
    Dim lnumRows As Long, lnumCols As Long
    Dim rngDestRange As Range, rngCellDest As Range
    Dim i As Long, j As Long, x As Long
    Dim lCounter As Long


    If Selection.Count < 4 Then
        MsgBox "Debe seleccionar un rango de por lo menos cuatro celdas", vbExclamation
        Exit Sub
    End If

    lnumRows = Application.InputBox("Cuantas filas en la matriz?", "Filas", , , , , , 2)
    lnumCols = Application.InputBox("Cuantas columnas en la matriz?", "Columnas", , , , , , 2)

    ReDim Arr_1(1 To lnumCols, 1 To lnumRows)

    Set rngCellDest = Application.InputBox("Posicion de la primera celda de la matriz", "Copiar matriz", , , , , , 8)
    Set rngDestRange = rngCellDest.Range(Cells(1, 1), Cells(lnumCols, lnumRows))

    lCounter = 0

    For j = 1 To lnumRows
        For i = 1 To lnumCols
            Arr_1(j, i) = Selection.Item(lCounter + 1)
            lCounter = lCounter + 1
        Next i
    Next j

    rngDestRange.Value = WorksheetFunction.Transpose(Arr_1)


End Sub
0

1 respuesta 1

0

Los pasos serían los siguientes:

  1. Seleccionar y copiar el rango a Transponer
  2. Seleccionar el rango destino y pegar de forma especial

    Sub Transponer()
    '
    ' Transponer Macro
    '
    '
        Range("A1:A10").Select
        Selection.Copy
        Range("B1").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    End Sub

A partir de este código básico puedes agregar parámetros y mensajes a conveniencia.

Consideraciones: *El código vba puede variar ligeramente en dependencia de la versión de excel.

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.