Macro convertir un Rango Dinámico (no tiene referencias fijas) en tres columnas
"para Dante Amor"
Tengo una tabla (malla) en excel de x filas, y columnas, estas pueden variar,
Tengo un Rango de datos en Excel de x filas, y columnas (tanto el tamaño del rango como, su posición puede variar)
Pongo tres ejemplos de donde y como pueden, estar y ser los datos del rango (PERO PUEDE VARIAR):
Ejemplo 1
Ejemplo 2
Ejemplo 3
Y
Y necesito una macro que en cualquier situación Rango Dinámico, "EJEMPLO 1"o " EJEMPLO 2" o, " EJEMPLO 3" o cualquier rango de datos (comentar que ese rango siempre estaría junto) por ejemplo que coja el rango de las celdas no vacías, (es decir sin hacer referencia a una celda en concreto), por ejemplo de esa sheet coger como rango la primera celda (fila y columna) no vacía, hasta la ultima celda (fila y columna) no vacías y las ponga en otra pestaña en 3 columnas de la siguiente forma, por ejemplo para origen "EJEMPLO 3", el resultado seria "RESULTADO EJEMPLO 3":
Es decir primera columna RESULTADO EJEMPLO 3, va repitiendo el valor primer valor de la primera fila del rango EJEMPLO 3, segunda columna RESULTADO EJEMPLO 3, a poniendo el primer valor (encabezado) de la primera columna EJEMPLO 3 y en la tercera columna sus cruces.
La segunda fila de la primera columna RESULTADO EJEMPLO 3, repite el mismo valor de la primera fila EJEMPLO 3, hasta completar, todos los datos del encabezado de la tabla EJEMPLO 3, y en la tercera columna RESULTADO EJEMPLO 3 pone los cruces. Segun imagenes, tengo los datos de EJEMPLO 3 y quiero conseguir RESULTADO EJEMPLO 3. Pero como dije la macro tiene que servir para que ella misma busque el rango y luego aplique a ese rango lo antedicho.
1 respuesta
Te anexo la macro actualizada
Sub el()
'Por.Dante Amor
Set h1 = Sheets("ORIGEN")
Set h2 = Sheets("RESULTADO")
tabla = h1.UsedRange.Address
h2.Cells.Clear
'
fini = h1.Range(tabla).Cells(1, 1).Row
cini = h1.Range(tabla).Cells(1, 1).Column
ffin = h1.Range(tabla).Rows.Count + fini - 1
cfin = h1.Range(tabla).Columns.Count + cini - 1
'
k = 4
m = 2
For i = fini + 1 To ffin
For j = cini + 1 To cfin
h2.Cells(k, m) = h1.Cells(i, cini)
h2.Cells(k, m + 1) = h1.Cells(fini, j)
h2.Cells(k, m + 2) = h1.Cells(i, j)
k = k + 1
Next
Next
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Ante todo pido disculPas por contestar tan tarde, me ha surgido un viaje de trabajo y no he podido, sin embargo Dante Amor cuando yo hice la pregunta contestó inmediatamente! Digo disculpas. Con respecto a la Macro es justo lo que necesitaba, hace exactamente lo que pedía, no hay mas que decir, Muchisssimas gracias a Dante Amor, por su gran ayuda. Mereceria 100 manos de votación! Pero solo puedo poner 2 excelente, hay las tiene, gracias
