Unir varios Excel en uno solo
Tengo varios ficheros de excel en un mismo directorio, de los cuales, quiero extraer los datos de una pestaña concreta (la misma en todos) y que se cree un nuevo libro donde se copien estos valores.
He encontrado una macro, que me deja escoger los ficheros de los que deseo extraer la info, y me lo pega en un nuevo libro. El problema es que me pega todos los valores, de todas las pestañas...
Os pego la macro, y aver si me podéis ayudar:
Sub Open_Files()
Dim Hoja As Object
Application.ScreenUpdating = False
'Definir la variable como tipo Variante
Dim X As Variant
'Abrir cuadro de dialogo
X = Application.GetOpenFilename _
("Excel Files (*.xlsm), *.xlsx", 2, "Abrir archivos",, True)
'Validar si se seleccionaron archivos
If IsArray(X) Then ' Si se seleccionan
'Crea Libro nuevo
Workbooks. Add
'Captura nombre de archivo destino donde se grabaran los archivos seleccionados
A = ActiveWorkbook.Name
'*/********************
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
Workbooks(b).Close False
Next
Application.StatusBar = "Listo"
Call Unir_Hojas
End If
Application.ScreenUpdating = False
End Sub
Sub Unir_Hojas()
Dim Sig As Byte, Eliminar As Boolean
For Sig = 2 To Worksheets.Count
Worksheets(Sig).UsedRange.Copy _
Worksheets(1).Range("a1000000").End(xlUp).Offset(1)
Next
Application.DisplayAlerts = False
For Sig = 2 To Worksheets.Count
Worksheets(2).Delete
Next
Application.DisplayAlerts = True
End Sub
2 respuestas
. 24.11.16 #VBA juntar archivos en uno
Buenas tardes, Blin
A continuación te paso una rutina que deberías agregar a tu archivo que funciona como receptor de las hojas de los archivos que tienes en esa carpeta
En ese archivo operativo, accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo (Insertar -Módulo) y pega el siguiente código:
Sub Consolid() '---- Variables modificables ---- '=== BLIN, modificá estos datos de acuerdo a tu proyecto: DirBusc = "C:\CarpetaDeArchivos" 'carpeta donde están los archivos Extension = "xls" 'Extensión de los archivos a consolidar. Dejar "*" para que sean todos TraerHoja = "Resultado" 'Hoja de donde tomar los datos de cada archivo JuntarEn = "consolidado" 'Hoja de destino. Limpiar = "SI" ' SI para vacíar la hoja consolidado o NO para que agregue a lo existente. '---- fin Variables ' '---- inicio de rutina: ' Sheets(JuntarEn).Select If Limpiar = "SI" Then Cells.Clear DirBusc = DirBusc & IIf(Right(DirBusc, 1) = "\", "", "\") Set ArchConsol = ActiveWorkbook LosArchivos = Dir(DirBusc & "*." & Extension) Application.DisplayAlerts = False Application.ScreenUpdating = False Do While LosArchivos <> "" Application.StatusBar = ">>>>>>>>>>>>>> Un momento, agregando hoja de archivo " & Left(LosArchivos, InStr(1, LosArchivos, Extension) - 2) Donde = Application.WorksheetFunction.CountA(ArchConsol.Sheets(JuntarEn).Cells) Donde = IIf(Donde > 0, Cells(Sheets(JuntarEn).UsedRange.Row + Sheets(JuntarEn).UsedRange.Rows.Count + 1, Sheets(JuntarEn).UsedRange.Column).Address, "A1") Workbooks.Open DirBusc & LosArchivos, xlNo Sheets(TraerHoja).Visible = True Sheets(TraerHoja).UsedRange.Copy ArchConsol.Sheets(JuntarEn).Range(Donde).PasteSpecial Paste:=xlPasteValues ArchConsol.Sheets(JuntarEn).Range(Donde).PasteSpecial Paste:=xlPasteFormats Workbooks(LosArchivos).Close xlNo cont = cont + 1 LosArchivos = Dir Loop Application.ScreenUpdating = True Application.DisplayAlerts = True ElMensaje = IIf(cont = 0, "NO SE AGREGO DATOS DE NINGUN ARCHIVO", "Se agregaron DATOS de : " & cont & " archivo" & IIf(cont > 1, "s", "")) TipoMens = IIf(cont = 0, vbCritical, vbInformation) ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!") Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo Set ArchConsol = Nothing Application.StatusBar = False End Sub
Nota que al principio del código le podrás indicar de qué carpeta leer los archivos y cual es la extensión que deseas considerar.
También están indicadas la hoja de destino y la de origen de cada archivo (no importa si estuviere oculta o no).
A falta de aclaración dejé una última variable que si dejas en SI, borrará todo lo que tiene la hoja de consolidación para empezar de nuevo. Si colocas NO, dejará los datos que tuviese al ejecutar la rutina.
El procedimiento se encarga de agregar a la hoja consolidación el contenido de la hoja Resultado de cada archivo que abra -como valores y con el formato original- y cierra el que abrió, sin cambios, para pasar al siguiente.
Pruebalo con tu caso real -y, si te sirviera, agradeceré que califiques mi contribución- o escribeme de nuevo aquí, si necesitas más apoyo con esto.
Un abrazo
Fernando
(Buenos Aires, Argentina)
.
Buenos días Fejoal y muchas gracias por tu respuesta!!!
He creado un archivo nuevo y en él he insertado la macro que me has puesto aquí, he seguido todos los pasos, grabo, y cuando la voy a ejecutar me aparece un fallo de "se ha producido el error 9".
Pulso "Depurar", y me aparece sombreado en amarillo "Sheets(JuntarEn).Select"
A ver si me puedes ayudar
.
Buenos días, Blin
Probablemente el paso que te falte es completar con los valores correctos las variables que te dejé al inicio del código. Allí te expliqué:
'=== BLIN, modificá estos datos de acuerdo a tu proyecto:
DirBusc = "C:\CarpetaDeArchivos" 'carpeta donde están los archivos
Extension = "xls" 'Extensión de los archivos a consolidar. Dejar "*" para que sean todos
TraerHoja = "Resultado" 'Hoja de donde tomar los datos de cada archivo
JuntarEn = "consolidado" 'Hoja de destino.
Limpiar = "SI" ' SI para vaciar la hoja consolidado o NO para que agregue a lo existente.
'---- Fin Variables
Nota que el error de la rutina se dá cuando tiene que elegir la hoja donde se deben agregar los datos de los archivos a juntar.
Verifica que los nombres sean los correctos y no olvides que tienen que indicarse entre comillas dobles.
Prueba con esto y dime.
Saludos
Fer
.
Buenos días,
he revisado todo varias veces, y me sigue dando error. Te copio lo que tengo:
Sub Consolid()
'---- Variables modificables ----
'=== BLIN, modificá estos datos de acuerdo a tu proyecto:
DirBusc = "V:\Prueba" 'carpeta donde están los archivos
Extension = "xls" 'Extensión de los archivos a consolidar. Dejar "*" para que sean todos
TraerHoja = "CAPTURA PREVISIONES" 'Hoja de donde tomar los datos de cada archivo
JuntarEn = "nuevo" 'Hoja de destino.
Limpiar = "NO" ' SI para vacíar la hoja consolidado o NO para que agregue a lo existente.
'---- fin Variables
.
Buenos días, Blin
A menos que tengas un problema con el acceso a la unidad "V:", no veo inconveniente en el resto de las variables, supuesto -claro- que estuvieran correctamente escritas.
Ayudaría que copies el texto del error y la línea que se marca cuando le das Depurar al mensaje de error.
Saludos
Fer
.