Una macro que copie la información de todas las hojas (estas varían) de varios libros y las pegue juntas en una sola hoja

Tengo varios libros y estos a su vez cuentan con distintos números de hoja, necesito que la macro abra libro por libro, me extraiga la información de cada una de las hojas y la pegue en la hoja de un archivo (consolidado) una debajo de otra, toda la información a copiar comienza en la celda "b7" y es variable la fila de termino.

Espero puedan ayudarme lo eh intentado pero no logro conseguir que funcione.

1 Respuesta

Respuesta
2

H o l a:

Antes de empezar con la macro, dime lo siguiente:

  1. El libro con la macro va a estar en la misma carpeta con los libros.?
  2. La información empieza en la columna "B", en la fila 7; pero en cuál columna acaba.?
  3. Cuál columna de los archivos siempre tiene datos.?
  4. Cómo se llama la hoja del libro "consolidado".?
  5. La hoja "consolidado" ya tiene información, los nuevos datos se tienen que pegar debajo la información existente.?
  6. Si ya tiene información, pero quieres que se borre, entonces en cuál fila se empezaría a pegar la información.?
  7. En cuál columna se empezaría a pegar la información.?
  8. El pegado es con pegado especial solamente valores.?

E spero tus comentarios en ese orden.

1.- el libro si estará en la misma carpeta

2.- la información comienza en la columna "b" fila "7", termina en la columna "F"

3.- las 5 columnas siempre contendrán datos

4.- la hoja se llama "Datos presupuestados"

5.-la hoja no tiene información, se comenzaran a pegar igualmente desde la columna "B" fila "7" hasta la columna "F" Fila "la que sea necesaria".

6.- Necesito que comiencen a pegarse sucesivamente, es decir, si termina los primeros datos en fila "200" que los siguientes datos se peguen a partir de la fila "201"

7.- Se comenzara a pegar en Columna "B" fila "7"

8.- solo valores

Agradezco tu ayuda

H o l a:

Te anexo la macro

Sub ConsolidarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Datos presupuestados")
    '
    h1.Cells.ClearContents
    ruta = l1.Path & "\"
    arch = Dir(ruta & "*.xls*")
    Do While arch <> ""
        If arch <> l1.Name Then
            Set l2 = Workbooks.Open(ruta & arch)
            For Each h In l2.Sheets
                u = h.Range("B" & Rows.Count).End(xlUp).Row
                f = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
                If f < 7 Then f = 7
                h.Range("B7:F" & u).Copy
                h1.Range("B" & f).PasteSpecial xlValues
            Next
            l2.Close False
        End If
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Proceso de consolidación terminado", vbInformation, "CONSOLIDAR DATOS"
End Sub

Hola de nuevo

Me envía un error que dice "subíndice fuera del intervalo"

En el renglón:

 Set h1 = l1.Sheets("Datos presupuestados")

Tienes que poner la macro en libro que tiene la hoja "Datos presupuestados", ejecuta la macro nuevamente, pero en libro que tiene esa hoja.

ahí la pegue pero me marca ese error, están en la misma carpeta, el libro se llama "consolidado",la hoja se llama "Datos presupuestados" y no corre.

Revisa el nombre de tu hoja, que no tenga espacios en blano antes o después del nombre.

O cambia el nombre en la macro por "Hoja1" y crea una hoja que se llame "Hoja1" y ejecuta la macro

solo cambie la frase "Datos presupuestados" por "1" y corrió, solo que olvide mencionar que los libros de donde se extrae la información comienzan en la hoja 2, por lo que me copio la información de la hoja 1 que no sirve podrías indicarme que cambiar para que se salte esa hoja? 

Te agradezco y perdón por tanta molestia.

El nombre de tu hoja estaba con espacios, yo solamente tomé el nombre que escribiste:

"4.- La hoja se llama "Datos presupuestados""

La macro funciona con lo que solicitaste, podrías valorar la respuesta.

No vas a valora la respuesta, la macro cumple con lo que solicitaste. Solamente valora el esfuerzo que se realiza. Es lo que se les pide a cambio.

Ya tengo el cambio que solicitaste pero la macro funcionaba bien desde el comienzo.

Te anexo la macro actualizada:

Sub ConsolidarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Datos presupuestados")
    '
    h1.Cells.ClearContents
    ruta = l1.Path & "\"
    arch = Dir(ruta & "*.xls*")
    Do While arch <> ""
        If arch <> l1.Name Then
            Set l2 = Workbooks.Open(ruta & arch)
            For Each h In l2.Sheets
                If h.Index > 1 Then
                    u = h.Range("B" & Rows.Count).End(xlUp).Row
                    f = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
                    If f < 7 Then f = 7
                    h.Range("B7:F" & u).Copy
                    h1.Range("B" & f).PasteSpecial xlValues
                End If
            Next
            l2.Close False
        End If
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Proceso de consolidación terminado", vbInformation, "CONSOLIDAR DATOS"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas