Excel - Unir archivos excel en uno solo

   
Vista:

Unir archivos excel en uno solo

Publicado por Hector Alcantara (2 intervenciones) el 04/12/2017 23:48:02
Hola! tengo una macro para unir archivos en uno solo excel , el tema es que los nombres de los archivos van cambiando conforme el dia y hora, no siempre tienen el mismo rango y necesito unir todos los archivos de un fichero en diferentes hojas del mismo archivo
1° documento xlsx en la primer hoja
2° documento xlsx en la segunda hoja
3° documento xlsx en la tercer hoja
y después de unirlos que los borre del fichero sin eliminar el archivo master

¿Alguna sugerencia?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub UnirLibros()
'x Elsamatilde
Dim sh As Object
Application.DisplayAlerts = False
'el nombre del libro actual, con la macro
libro1 = ActiveWorkbook.Name
'tomo como ruta la del libro activo
ruta = ActiveWorkbook.Path
ChDir ruta & "C:\Indra\Control"
'revisar la extensión de los libros a unir
archi = Dir("*.xlsx*")
Do While archi <> libro1 And archi <> ""
Workbooks.Open archi
'nombre del libro que se abrió
libro2 = ActiveWorkbook.Name
For Each sh In ActiveWorkbook.Sheets
'coloco el fin de rango de la hoja 1 del libro destino en una variable para ajustarla a criterio
'aquí se evalua la col A de la hoja 1
finx = Workbooks(libro1).Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
'copio rango de cada hoja
sh.Range("A1").CurrentRegion.Copy Destination:=Workbooks(libro1).Sheets(1).Range("A" & finx)
Next
'cierra el libro y procede a buscar el siguiente
Workbooks(libro2).Close False
archi = Dir()
Loop
MsgBox "Fin del proceso"
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana

Unir archivos excel en uno solo

Publicado por Antoni Masana (809 intervenciones) el 11/12/2017 10:19:53
Un par de detalles:

La línea 13 (ChDir) tal cual esta tiene que dar un error:

1
2
3
4
Esto
      ChDir "C:\Indra\Control"
o esto:
      ChDir ruta

La condición del WHILE esta mal porque cuando encuentre el LIBRO1 finalizara.

Por otro lado no creo que lo encuentre porque la extensión debería ser .XLSM (porque tiene la macro) y solo buscas los los .XLSX, si vas a tratar todas las posibles debería poner *.XLS*

Creo que lo mejor seria tener el fichero master en un directorio y los que tienes que incluir en otro, un temporal o de trabajo.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub UnirLibros()
    ' ---&---  x Elsamatilde
    Dim sh As Object
    Application.DisplayAlerts = False
    ' ---&---  el nombre del libro actual, con la macro
    libro1 = ActiveWorkbook.Name
    ' ---&---  tomo como ruta la del libro activo
    ruta = ActiveWorkbook.Path
    ChDir ruta & "C:\Indra\Control"
    ' ---&---  revisar la extensión de los libros a unir
    archi = Dir("*.xlsx*")
    Do While archi <> ""
        If archi <> libro1 Then
            Workbooks.Open archi
            ' ---&---  nombre del libro que se abrió
            libro2 = ActiveWorkbook.Name
            For Each sh In ActiveWorkbook.Sheets
                ' ---&---  coloco el fin de rango de la hoja 1 del libro destino en una variable para ajustarla a criterio
                ' ---&---  aquí se evalua la col A de la hoja 1
                finx = Workbooks(libro1).Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
                ' ---&---  copio rango de cada hoja
                sh.Range("A1").CurrentRegion.Copy Destination:=Workbooks(libro1).Sheets(1).Range("A" & finx)
            Next
            ' ---&---  cierra el libro y procede a buscar el siguiente
            Workbooks(libro2).Close False
            Kill (libro2)       ' <-- Borra el fichero procesado
            archi = Dir()
        End If
    Loop
    MsgBox "Fin del proceso"
End Sub

No entiendo que es exactamente lo que quieres decir con esto: "y después de unirlos que los borre del fichero sin eliminar el archivo master"

Te pongo una opción que elimina el fichero procesado.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Unir archivos excel en uno solo

Publicado por Hector (2 intervenciones) el 11/12/2017 21:46:52
Captura


Como se muestra la imagen se copian los tres archivos de manera correcta, la parte de eliminar los archivos quedo fabulosa, gracias por ello pero lo que realmente ocupo es que cada documento dentro de la carpeta se pegue en una hoja individual y cada que se ejecute se sustituya sobre la información en esa hoja
1° documento xlsx en la primer (hoja1)
2° documento xlsx en la segunda( hoja2)
3° documento xlsx en la tercera ( hoja 3)

Pero mi conflicto es que no eh podido realizar esa acción, eh avanzado un poco con el cogido y ahora llevo esto, Si copia cada documento en una hoja pero no en la primer fila y no lo sustituye ¿Tendrías alguna sugerencia o comentario ?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub UnirLibros()
Dim sh As Object
Dim i As Integer
i = 1
Application.DisplayAlerts = False
'el nombre del libro actual, con la macro
libro1 = ActiveWorkbook.Name
'tomo como ruta la del libro activo
ChDir ruta & "C:\Indra\Control"
'revisar la extensión de los libros a unir
archi = Dir("*.xlsx*")
Do While archi <> libro1 And archi <> ""
Workbooks.Open archi
'nombre del libro que se abrió
libro2 = ActiveWorkbook.Name
For Each sh In ActiveWorkbook.Sheets
 
'coloco el fin de rango de la hoja 1 del libro destino en una variable para ajustarla a criterio
'aquí se evalua la col A de la hoja 1
finx = Workbooks(libro1).Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
'copio rango de cada hoja
sh.Range("A1").CurrentRegion.Copy Destination:=Workbooks(libro1).Sheets(i).Range("A" & finx)
Next
 
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
i = i + 1
'cierra el libro y procede a buscar el siguiente
Workbooks(libro2).Close True
archi = Dir()
Loop
MsgBox "Fin del proceso"
End Sub


Saludos!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Revisar política de publicidad