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

Respuesta
1

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.

Respuesta
1

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
Respuesta
1

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.

Respuesta
1

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas