Problema con Colocacion por debajo de columnas excell

.28.03.17

Hola, Maximiliano

Conceptualmente, no es posible dividir una columna en varias, pero si es posible hacer lo contrario, es decir unir varias columnas en una.

Fijate en la siguiente imagen:

Selecciona las celdas desde tu columna 1 hasta la 1780 que quieras unificar -puedes tomar más de una fila si quisieras también- y presiona el botón "Combinar y centrar".

Así obtendrás algo cercano a lo que estabas buscabas.

Espero que te sirva como solución.

Un abrazo

Fernando

.

fernando, me parece que no entendió la consulta! Yo necesito poner las 1700 columnas una abajo de la otra la estructura seria así

1(columna 1)

2(columna 2)

.

.

.

1700(columna 1700)

Combinar y centrar no me sirve

.

Hola, Maximiliano

Ahora entiendo mejor. Creo.

Quieres agrupar verticalmente -en una columna- lo que tienes horizontalmente en tus 1780 columnas. Desde luego Combinar y centrar no es la solución para ello.

En cambio, te comparto esta rutina que, entiendo, hace lo que necesitas.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub JuntaCol()
'---- Variables modificables ----
'=== MAXIMILIANAO, modifica estos datos de acuerdo a tu proyecto:
    CeldaOrig = "D5" 'celda inicial de transferencia de columnas (sin títulos)
    CeldaDest = "B5" 'celda inicial donde se acumularán las columnas
'---- fin Variables
'
'---- inicio de rutina:
'  
Application.ScreenUpdating = False
CantCols = Range(CeldaOrig).CurrentRegion.Columns.Count
IniTime = Now
For LaColu = 0 To CantCols - 1
    'determina última fila donde pegar cada columna:
' 
    If Not IsEmpty(Range(CeldaDest).Offset(0).Value) Then
        UltFilaD = Range(Left(CeldaDest, 1) & Rows.Count).End(xlUp).Row
        CeldaDest = Left(CeldaDest, 1) & UltFilaD + 1
    End If
    'Determina rango de columna a llevar
'  
    Colu = Range(CeldaOrig).Offset(0, LaColu).Column
    UltFila = Cells(Rows.Count, Colu).End(xlUp).Address
    Range(Range(CeldaOrig).Offset(0, LaColu), UltFila).Copy
    Range(CeldaDest).PasteSpecial Paste:=xlPasteValues
    Range(CeldaDest).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    cont = cont + 1
Next
    FinTime = Now - IniTime
    FinTime = Format(FinTime, "hh:mm:ss")
    RatioC = 1 / (24 * 60 * CLng(60)) ' 1 segundo
    On Error Resume Next
    RatioC = Format(RatioC * (cont) / FinTime, "#,###")
    On Error GoTo 0
    Err.Clear
ElMensaje = IIf(cont = 0, "NO SE TRASLADO COLUMNA ALGUNA", "Se transfirieron: " & cont & " columna" & IIf(cont > 1, "s", "") & Chr(10) & "a la hoja " & HojaDest & "en un tiempo de " & FinTime & " (hh:mm:ss)" & Chr(10) & Chr(10) & "(Ratio: " & RatioC & " registros por segundo)" & Chr(10) & "desde: " & Format(IniTime, "hh:mm:ss") & Chr(10) & "hasta: " & Format(Now, "hh:mm:ss"))
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Verás que al inicio del código hay dos variables para que le indiques donde inicia el rango de columnas y donde debe pegarlas.

La rutina determina cuántas son las columnas a transferir y cual es la última fila ocupada de cada una de ellas.

Pruebalo y dime si es lo que buscabas.

Un abrazo

Fer

.