Jump to content

Macro para unificar libros en un solo libro, dividiendolo por hojas.


Recommended Posts

Hola a todos!

Quería saber si me pueden ayudar con este problema. El problema surge porque tengo 133 archivos de excel, y me gustaría poder copiarlos a todos en un solo excel, dividiendo la información de cada archivo en una hoja, y respetando el orden de numeracion, es decir, la información del archivo llamado 1, se coloque en la hoja 1, la del archivo dos, en hoja 2, y así sucesivamente. 

He encontrado Macros que realizan este trabajo, pero copian toda la información en una sola hoja, y el recorrido de Archivos es aleatorio, por lo que me modifica el orden necesario de los mismos. 

 

Un saludo y ojalá puedan ayudarme. 

Link to comment
Share on other sites

Adjunto un archivo y la macro que encontré:

Option Explicit
Dim nArchivo As Integer, Conteo As Integer, i As Integer, j As Integer, n As Integer
Sub ImportarData()

Call ContarArchivos
   
Application.ScreenUpdating = False
Dim WorkBookOrigen As Workbook
    Dim wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range, _
    NombreArchivo As String, _
    Carpeta As String
    
    Carpeta = ActiveWorkbook.Path & "\"

nArchivo = 1

NombreArchivo = Dir(Carpeta & "LibroO" & "*.xl*")


Do While Len(NombreArchivo) > 0
    


        Set WorkBookOrigen = Workbooks.Open(Carpeta & NombreArchivo)
            
            NombreArchivo = Dir()
            
        ThisWorkbook.Activate
            
        Set wsOrigen = WorkBookOrigen.Worksheets(1)
        Set wsDestino = Worksheets(1)
        
        Const celdaOrigen = "A1"
        
        Set rngOrigen = wsOrigen.Range(celdaOrigen)
        
        wsOrigen.Activate
        rngOrigen.Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        
Errores:
        If Err.Number = 1004 Then
            wsOrigen.Activate
            rngOrigen.Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
        End If
        
            For n = 1 To 1
            wsDestino.Activate

On Error GoTo Errores

                wsDestino.Cells(Columns.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Next n
            Application.CutCopyMode = False
        
        WorkBookOrigen.Save
        WorkBookOrigen.Close
        
        nArchivo = nArchivo + 1
        
    Call Progreso
                    

Loop

j = nArchivo - 1


Application.ScreenUpdating = True


MsgBox j & " Archivos procesados"

End Sub
Public Sub Progreso()
Dim Contador As Integer
Dim Maximo As Integer
Dim Mitiempo As Double

Maximo = nArchivo - 1
 
For Contador = 1 To Maximo Step 1
    Mitiempo = Timer
    Do
        Loop While Timer - Mitiempo < 0.02
        Application.StatusBar = "Progreso: " & Maximo & _
        " de " & i & " (" & Format(Maximo / i, "Percent") & ")"
    DoEvents
Next Contador
 
Application.StatusBar = False
End Sub
Public Sub ContarArchivos()
Dim cNombreArchivo, cCarpeta As String


cCarpeta = ActiveWorkbook.Path & "\"

Conteo = 1

cNombreArchivo = Dir(cCarpeta & "LibroO" & "*.xl*")

Do While Len(cNombreArchivo) > 0
    cNombreArchivo = Dir()
    Conteo = Conteo + 1
Loop

i = Conteo - 1
End Sub
 

 

499.xls

Link to comment
Share on other sites

Yo pedí demasiado detalle, el que lo separe por hoja ya es por gusto, el que esté todo presente en una hoja ya me facilita mucho el análisis. 

Veremos cómo nos sorprende!

Un gusto y nos vemos por el foro!

Link to comment
Share on other sites

Hace 16 horas, JSDJSD dijo:

Hola de nuevo, disculpa que te moleste.

Te quería consultar si esa macro se puede modificar para que nunca copie la fila 1, y que no inserte un espacio cada vez que pega el contenido en la hoja agrupación.

Según mis básicos conocimientos de VB esto se modificaría en la parte siguiente, pero no estoy seguro como realizarlo:

For y = LBound(X) To UBound(X)
            Application.StatusBar = "Importando Archivos: " & X(y)
            Workbooks.Open X(y)
            b = ActiveWorkbook.Name
            For Each Hoja In ActiveWorkbook.Sheets
                Hoja.Copy after:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count)
            Next

El motivo de esta modificación es para luego poderle dar formato de tabla y trabajar con los datos más ordenados.

Muchas gracias!

Link to comment
Share on other sites

  • 3 weeks later...
  • Crear macros Excel

  • Posts

    • La parte de intercalar no la había captado Adjunto de nuevo mi método Espero ahora si, quede listo   Saludos! Mover filas filtradas otra hoja_GP.xlsm
    • Buenas noches nuevamente a los Foristas. A sugerencia de JSD  de los problemas que le planteaba sobre el formulario, abro un nuevo tema. Ofrezco disculpas porque realmente es así como debe ser. El tema es el siguiente: Tengo en este formulario otros problemas que quizás puedan ayudarme: realmente he tratado de ver dónde está el error, pero mis conocimientos no alcanzan y ustedes son los MAESTROS. 1.- En el FrmPersonal trabajo lo que es el listado de Personal con todos los datos y las Nóminas de Salario. En la parte de las nóminas (LstNomina) ya lo configuré de tal manera que con el evento DobleClick pueda traer cualquier trabajador y poder modificar algún dato que por error se haya introducido. Este trabaja Bien, pero en el LstPersonal, estoy tratando de hacer lo mismo y no me está queriendo tomar los datos para su modificación. No me da error, pero no lo hace y he buscado, pero no encuentro el posible problema. 2.- En este mismo Formulario (FrmPersonal), no acabo de poner bien el código VBA para los OptionButton de Sexo. 3.- En este Proyecto también tengo o quiero en el FrmBuscarEntradas poder modificarlo y que a través de un ComboBox o de Botones de Opción poder hacer la búsqueda no sólo de las Entradas, sino también de las Salidas y la Existencia. Esto para evitarme tener que hacer uno para cada uno y reducir los Formularios. ¿Podrías ayudarme con estos temas? Un abrazo a todos. Espero puedas ayudarme y excelente semana para todos. Un abrazo caluroso y cordial. Pino.   Mi Negocio Foro.xlsm
    • Buenas Noches a todos los Foristas. Gracias JSD por su aporte. Revisaré dónde estaba el problema para evitar el mismo error en lo adelante y aprender. Gracias a los demás miembros del Foro también. Tema cerrado.
    • Hola, Gerson. Pues es que solo se mueven todas las salidas de golpe tanto si filtras a mano como si no y todos las referencias de producto a la vez de salidas. No es el ejemplo 2.. no sé... pensaba que la pregunta era clara y tendría fácil solución. El código de mi ejemplo es super sencillo y lo he explicado paso a paso en la macro. En el ejemplo 1 funciona y en el ejemplo 2 es exactamente igual solo que los registros están filtrados.  Comienzo siempre con una salida y luego se van alternando (una entrada, una salida... hay condiciones) hasta que ya no quedan datos en las hojas. Primero para Referencia 1 (filtrada). La idea es al terminar quitar el filtro y hacer lo mismo para referencia 2 (como en el ejemplo 1 que funciona). Gracias.  
  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy