Buscar criterio en columna y transponer el contenido de las celdas siguientes en fila, luego repetir
Hola,
En una sola columna tengo toda la información que debo categorizar en un máximo de 8 columnas distintas. El problema es que no puedo simplemente transponer el contenido de la columna cada 8 celdas porque la cantidad de celdas a transponer varía entre 3 y 8.
La celda que indicará el primer valor a transponer comienza con un guión bajo "_" para facilitar su búsqueda. Es decir, esta celda con "_" debe ser la primera celda transpuesta, el orden de las siguientes celdas a transponer en la misma fila no me importa.
En resumen, el contenido de la celda (que comienza con "_") se debe transponer junto a un máximo de 7 celdas más (en total se transponen un máximo de 8 celdas contiguas).
He copiado al final un ejemplo del contenido que tengo en la columna a organizar. (Si utilizan este ejemplo, por razones de formato de esta web, deben eliminar las celdas en blanco que les puedan aparecer, ya que no tengo ninguna en mi columna. Lo siento pero no he podido solucionar esto).
Desde ya, agradecería cualquier tipo de ayuda.
Agustín
_28 Dec
Agustin @hogar
¿Cuál es el nombre de tu hermano?
View video
Rett
_30 Dec
Rambo @televo
Nuestros operarios revisan las líneas en cualquier circunstancia
View photo
View video
View media
Repp
Rett
_28 Dec
Carlos @supermercado
Hay descuentos en todos los productos
View video
View photo
Repp
Rett
_30 Dec
Cinema @jorge
Qué mejor manera que acabar el año
_12 Ene
Ordenanza @ivan
La pantera rosa es rosa
_13 Ene
Ramiro @tierra
Me gusta viajar
View video
View photo
Rett
_15 Ene
César @casa
El día está soleado
View video
View photo
Rett
View media
Repp
_20 Ene
Ramón @monte
La humedad variará
1 Respuesta
Te mando la solución, sigue mis pasos:
He copiado todos tus datos en la columna A desde A1 hacia abajo
Después posiciónate en la primera celda, es decir, en la A1 y ejecuta esta macro:
Sub transponer() fila = 1 primera = ActiveCell.Address Do While ActiveCell.Value <> "" ActiveCell.Offset(1, 0).Select If Left(ActiveCell, 1) = "_" Then ActiveCell.Offset(-1, 0).Select posicion = ActiveCell.Address Range(primera, ActiveCell).Copy Cells(fila, 2).PasteSpecial Paste:=xlValues, Transpose:=True fila = fila + 1 Range(posicion).Select ActiveCell.Offset(1, 0).Select primera = ActiveCell.Address ElseIf ActiveCell.Value = "" Then ActiveCell.Offset(-1, 0).Select Range(primera, ActiveCell).Copy Cells(fila, 2).PasteSpecial Paste:=xlValues, Transpose:=True Exit Sub End If Loop End Sub
recuerda finalizar y puntuar
Muchas gracias luismondelo. He corrido el macro y funciona de maravilla. Es de destacar la velocidad y excelencia con la que has solucionado mi consulta. Nuevamente te agradezco mucho.
Un saludo,
Agustín
