Extraer cabeceras en una columna
Tengo un excel que contiene cabeceras y debajo de ellas información referente.
Necesito un excel nuevo, que me incluya solo el nombre del CENTRO que está en la cabecera como una columna con el resto de información, para poder subirlo a BBDD
ORIGINAL
DESEADO
4 Respuestas
Es un excel que nos envía un cliente al menos 2 veces al mes con más de 12 mil filas, entre las que se encuentran las cabeceras de los centros, hacerlo a mano es bastante complicado, buscaba alguna macro que me ayude a automatizarlo.
Este ejemplo, este es el antes (no me quedo claro si es uno o varios centros de costos, así que la macro la hice para el segundo caso)
este es el despues
y esta es la macro
Sub AGREGAR_COLUMNA()
CUENTA = WorksheetFunction.CountIf(Cells, "CENTRO")
Range("A1").EntireColumn.Insert
For I = 1 To CUENTA
With Range("b:b")
If I = 1 Then Set BUSCA = .Find("CENTRO")
If I > 1 Then Set BUSCA = .FindNext(BUSCA)
End With
Set datos = Range(BUSCA.Address).CurrentRegion
XCENTRO = Range(BUSCA.Address).Offset(0, 1)
With datos
.Columns(0) = XCENTRO
Range(BUSCA.Address).EntireRow.ClearContents
.Cells(2, 0) = "CENTRO"
End With
Next I
Set datos = Nothing
End Sub
¡Muchísimas Gracias!
Hola James!
He lanzado la macro y tiene buena pinta pero no me sale del todo OK.
Te doy más datos del fichero original porque me explico fatal.
Este es el comienzo del fichero
Cuando acaba un centro y el comienzo del otro es así
He aplicado tu macro
Resultados
Cabecera:
Cuando acaba un centro y comienza el otro
Yo necesito que solamente aparezca una línea de cabecera al comienzo del fichero, y de ahí en adelante solo los datos, justo como los tengo con el Centro, fecha etc..
Este es el resultado de la macro modificada
y de nuevo esta es la macro
Sub AGREGAR_COLUMNA()
CUENTA = WorksheetFunction.CountIf(Cells, "CENTRO")
Range("A1").EntireColumn.Insert
For I = 1 To CUENTA
With Range("b:b")
If I = 1 Then Set BUSCA = .Find("CENTRO")
If I > 1 Then Set BUSCA = .FindNext(BUSCA)
End With
Set datos = Range(BUSCA.Address).CurrentRegion
XCENTRO = Range(BUSCA.Address).Offset(0, 1)
With datos
.Columns(0) = XCENTRO
.Cells(2, 0) = "CENTRO"
.Cells(1, 0) = Empty
End With
Next I
Set datos = Nothing
End Sub
No entiendo muy bien lo que deseas pero por lo que parece, lo más sencillo es duplicar lo que tienes, para no perderlo y luego borrar lo que te sobra.
Es un excel que nos envía un cliente al menos 2 veces al mes con más de 12 mil filas, entre las que se encuentran las cabeceras de los centros, hacerlo a mano es bastante complicado, buscaba alguna macro que me ayude a automatizarlo.
Si siempre es igual puedes guardar una macro (gravada) en el libro de macros personal y añadir un botón a la cinta de opciones.
La macro la gravas realizandolo la primera vez.
Esto a lo mejor sirve en algo o da una idea