Note: The other languages of the website are Google-translated. Back to English

¿Cómo recorrer archivos en un directorio y copiar datos en una hoja maestra en Excel?

Suponiendo que hay varios libros de Excel en una carpeta, y desea recorrer todos estos archivos de Excel y copiar datos de un rango especificado de hojas de trabajo del mismo nombre en una hoja de trabajo maestra en Excel, ¿qué puede hacer? Este artículo presenta un método para lograrlo en detalle.

Recorra los archivos en un directorio y copie los datos en una hoja maestra con código VBA


Recorra los archivos en un directorio y copie los datos en una hoja maestra con código VBA

Si desea copiar datos especificados en el rango A1: D4 de todos los libros de la hoja 1 en una carpeta determinada a una hoja maestra, haga lo siguiente.

1. En el libro de trabajo creará una hoja de trabajo maestra, presione el otro + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En el Microsoft Visual Basic para aplicaciones ventana, haga clic recuadro > Módulo. Luego copie el código de VBA a continuación en la ventana de código.

Código VBA: recorra los archivos en una carpeta y copie los datos en una hoja maestra

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Nota::

1). En el código, "A1: D4 y Sheet1”Significa que los datos en el rango A1: D4 de toda la Hoja1 se copiarán en la hoja maestra. Y "Hoja nueva”Es el nombre de la nueva hoja maestra creada.
2). Los archivos de Excel en la carpeta específica no deberían abrirse.

3. presione el F5 clave para ejecutar el código.

4. En la apertura Búsqueda de ventana, seleccione la carpeta que contiene los archivos que recorrerá y luego haga clic en el OK botón. Ver captura de pantalla:

Luego, se crea una hoja de trabajo maestra llamada "Hoja nueva" al final del libro de trabajo actual. Y los datos en el rango A1: D4 de toda la Hoja1 en la carpeta seleccionada se enumeran dentro de la hoja de trabajo.


Artículos relacionados:


Las mejores herramientas de productividad de oficina

Kutools para Excel resuelve la mayoría de sus problemas y aumenta su productividad en un 80%

  • Reutilizar: Inserte rápidamente fórmulas complejas, gráficos y cualquier cosa que hayas usado antes; Cifrar celdas con contraseña; Crear lista de distribución y enviar correos electrónicos ...
  • Barra de súper fórmula (edite fácilmente varias líneas de texto y fórmulas); Diseño de lectura (leer y editar fácilmente un gran número de celdas); Pegar en rango filtrado...
  • Combinar celdas / filas / columnas sin perder datos; Contenido de celdas divididas; Combinar filas / columnas duplicadas... Prevenir celdas duplicadas; Comparar rangos...
  • Seleccione Duplicado o Único Filas; Seleccionar filas en blanco (todas las celdas están vacías); Super Find y Fuzzy Find en muchos libros de trabajo; Selección aleatoria ...
  • Copia exacta Varias celdas sin cambiar la referencia de la fórmula; Crear referencias automáticamente a varias hojas; Insertar viñetas, Casillas de verificación y más ...
  • Extraer texto, Agregar texto, Eliminar por posición, Quitar espacio; Crear e imprimir subtotales de paginación; Convertir entre contenido de celdas y comentarios...
  • Súper filtro (guardar y aplicar esquemas de filtros a otras hojas); Orden avanzado por mes / semana / día, frecuencia y más; Filtro especial en negrita, cursiva ...
  • Combinar libros y hojas de trabajo; Combinar tablas basadas en columnas clave; Dividir datos en varias hojas; Conversión por lotes de xls, xlsx y PDF...
  • Más de 300 potentes funciones. Compatible con Office/Excel 2007-2021 y 365. Compatible con todos los idiomas. Fácil implementación en su empresa u organización. Funciones completas Prueba gratuita de 30 días. Garantía de devolución de dinero de 60 días.
pestaña kte 201905

Office Tab lleva la interfaz con pestañas a Office y hace que su trabajo sea mucho más fácil

  • Habilite la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
  • Abra y cree varios documentos en nuevas pestañas de la misma ventana, en lugar de en nuevas ventanas.
  • ¡Aumenta su productividad en un 50% y reduce cientos de clics del mouse todos los días!
officetab parte inferior
Comentarios (20)
Aún no hay calificaciones. ¡Sé el primero en calificar!
Este comentario fue minimizado por el moderador en el sitio
gracias por el código vba! ¡Funciona perfectamente! ¿Me gustaría saber cuál es el código si necesito PEGAR COMO VALOR en su lugar? ¡Gracias de antemano!
Este comentario fue minimizado por el moderador en el sitio
Hola LaiLing,
El siguiente código puede ayudarte a resolver el problema. Gracias por tu comentario.

Sub Merge2MultiSheets ()
Dim xRg como rango
Dim xSelItem como variante
Dim xFileDlg como FileDialog
Dim xFileName, xSheetName, xRgStr como cadena
Dim xBook, xWorkBook como libro de trabajo
Dim xSheet como hoja de trabajo
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Hoja1"
xRgStr = "A1:D4"
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
con xFileDlg
Si .Mostrar = -1 Entonces
xSelItem = .SelectedItems.Item(1)
Establecer xLibroDeTrabajo = EsteLibroDeTrabajo
Establecer xSheet = xWorkBook.Sheets("Nueva hoja")
Si xSheet no es nada, entonces
xWorkBook.Sheets.Add(después de:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Nombre = "Nueva hoja"
Establecer xSheet = xWorkBook.Sheets("Nueva hoja")
Si terminar
xNombreArchivo = Dir(xSelItem & "\*.xlsx", vbNormal)
Si xFileName = "" Entonces Salir de Sub
Hacer hasta xFileName = ""
Establecer xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Establecer xRg = xBook.Worksheets(xSheetName).Rango(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xNombreArchivo = Dir()
xBook.Cerrar
Red ISTE Loop
Si terminar
End With
Establecer xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = Verdadero
xRg.UseStandardWidth = Verdadero
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Este comentario fue minimizado por el moderador en el sitio
Hola, gracias por el código. ¿Puede decirme cómo puedo incluir el nombre del archivo de Excel del que se copió el rango de datos? ¡Esto sería una gran ayuda!

Gracias por su atención.
Este comentario fue minimizado por el moderador en el sitio
Hola,

Gracias por el tutorial.

¿Cómo lo haría? Solo copiaría la fila en "Hoja 1" con valores de la fila "total" y pegaría con [nombre de archivo] en la hoja de trabajo maestra denominada "Nueva hoja". Notar que la fila con Total puede ser diferente en cada hoja de cálculo.

Por ejemplo:
Archivo1: Hoja1
Col1, Col2, Colx
1,2,15
Resultado,10,50

Archivo2: Hoja1
Col1, Col2, Colx
1,5,10
2,4,16
3,3,6
4,5,6
5,7,10
Resultado,300,500

MasterFile: "Hoja Nueva":
archivo1, 10, 50
archivo2, 300, 500
Este comentario fue minimizado por el moderador en el sitio
Hola, Esto funciona muy bien. ¿Hay alguna forma de cambiar para simplemente extraer los valores y no la fórmula?
¡¡Gracias!!
Este comentario fue minimizado por el moderador en el sitio
Hola Trish,
El siguiente código puede ayudarte a resolver el problema. Gracias por tu comentario.

Sub Merge2MultiSheets ()
Dim xRg como rango
Dim xSelItem como variante
Dim xFileDlg como FileDialog
Dim xFileName, xSheetName, xRgStr como cadena
Dim xBook, xWorkBook como libro de trabajo
Dim xSheet como hoja de trabajo
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Hoja1"
xRgStr = "A1:D4"
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
con xFileDlg
Si .Mostrar = -1 Entonces
xSelItem = .SelectedItems.Item(1)
Establecer xLibroDeTrabajo = EsteLibroDeTrabajo
Establecer xSheet = xWorkBook.Sheets("Nueva hoja")
Si xSheet no es nada, entonces
xWorkBook.Sheets.Add(después de:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Nombre = "Nueva hoja"
Establecer xSheet = xWorkBook.Sheets("Nueva hoja")
Si terminar
xNombreArchivo = Dir(xSelItem & "\*.xlsx", vbNormal)
Si xFileName = "" Entonces Salir de Sub
Hacer hasta xFileName = ""
Establecer xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Establecer xRg = xBook.Worksheets(xSheetName).Rango(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xNombreArchivo = Dir()
xBook.Cerrar
Red ISTE Loop
Si terminar
End With
Establecer xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = Verdadero
xRg.UseStandardWidth = Verdadero
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Este comentario fue minimizado por el moderador en el sitio
Hola, todavía extrae las fórmulas, no los valores, por lo que me da un error #REF. Sé que podría necesitar un .PasteSpecial xlPasteValues ​​en algún lugar, pero no puedo averiguar dónde. ¿Puede usted ayudar? ¡Gracias!
Este comentario fue minimizado por el moderador en el sitio
Hola gracias por esto


¿Cómo incluyo el código para recorrer todas las carpetas y subcarpetas y realizar la copia anterior?


¡Gracias!
Este comentario fue minimizado por el moderador en el sitio
Hola: este código es perfecto para lo que estoy tratando de lograr.

¿Hay alguna manera de recorrer todas las carpetas y subcarpetas y realizar la copia?


¡Gracias!
Este comentario fue minimizado por el moderador en el sitio
Hola: este código funciona muy bien para las primeras 565 líneas de cada archivo, pero todas las líneas posteriores se superponen con el siguiente archivo.
¿Hay alguna forma de solucionar este problema?
Este comentario fue minimizado por el moderador en el sitio
Gracias. ¿Cómo se podría copiar y pegar (valores especiales) de cada hoja de trabajo dentro de un libro de trabajo en hojas separadas dentro de un archivo maestro principal?
Este comentario fue minimizado por el moderador en el sitio
¿Cómo haces para que el código deje un espacio en blanco si la celda está vacía?
Este comentario fue minimizado por el moderador en el sitio
para mí, el nombre de la pestaña "Hoja1" cambia para cada uno de mis archivos. Por ejemplo, Tab1, Tab2, Tab3, Tab4... ¿Cómo puedo configurar un ciclo para ejecutar una lista en Excel y seguir cambiando el nombre de "Hoja1" hasta que se ejecuta a través de todo?
Este comentario fue minimizado por el moderador en el sitio
Hola Nick, el siguiente código de VBA puede ayudarte a resolver el problema. Por favor, inténtalo. Sub LoopThroughFileRename()
'Actualizado por Extendofice 2021/12/31
Dim xRg como rango
Dim xSelItem como variante
Dim xFileDlg como FileDialog
Dim xFileName, xSheetName, xRgStr como cadena
Dim xBook, xWorkBook como libro de trabajo
Dim xSheet como hoja de trabajo
Dim xShs como hojas
Dim xName como cadena
Dim xFNum como entero
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Establecer xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xFileDlg.Mostrar
xSelItem = xFileDlg.SelectedItems.Item(1)
xNombreArchivo = Dir(xSelItem & "\*.xlsx", vbNormal)
Hacer mientras xNombre de archivo <> ""
Establecer xWorkBook = Workbooks.Open(xSelItem & "\" & xFileName)
Establecer xShs = xWorkBook.Sheets
Para xFNum = 1 Para xShs.Count
Establecer xHoja = xShs.Item(xFNum)
xNombre = xHoja.Nombre
xNombre = Reemplazar(xNombre, "hoja""Tab audio") 'Reemplazar hoja con pestaña
xHoja.Nombre = xNombre
Siguiente
xWorkBook.Guardar
xWorkBook.Cerrar
xNombreArchivo = Dir()
Red ISTE Loop
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Este comentario fue minimizado por el moderador en el sitio
Hola, quiero un código para copiar los datos en 6 libros de trabajo diferentes (en una carpeta) que tiene hojas incluidas en el NUEVO LIBRO DE TRABAJO. en vba
por favor ayúdame asp
Este comentario fue minimizado por el moderador en el sitio
Hola Paranusha,
La secuencia de comandos de VBA del siguiente artículo puede combinar varios libros de trabajo u hojas específicas de libros de trabajo en un libro de trabajo maestro. Por favor, compruebe si puede ayudar.
¿Cómo combinar varios libros de trabajo en un libro de trabajo maestro en Excel?
Este comentario fue minimizado por el moderador en el sitio
Olá bom dia.
Gostei muito dessde código, mas não me ajudou com os relatórios que eu preciso impreimir.
Preciso imprimir 2.400 relatório de excel que estão em pastas diferentes y não estão configuradas corretamente para impressão. ¿Puede enviarme un código de VBA que automatice las impresiones? Me ajudaria muito, obrigada.
Este comentario fue minimizado por el moderador en el sitio
Hola María Soares,
Verifique si el código VBA en la siguiente publicación puede ayudar.
¿Cómo imprimir varios libros de trabajo en Excel?
Este comentario fue minimizado por el moderador en el sitio
Mi escenario es similar, excepto que tengo varias hojas en cada archivo, todas con nombres diferentes pero consistentes entre archivos. ¿Hay alguna manera de hacer un bucle con este código para copiar los datos dentro de los archivos y pegar (valores) en nombres de hojas específicos en el libro de trabajo maestro? Los nombres de las hojas en el maestro son los mismos que en los archivos. Quiero recorrerlos. Además, la cantidad de datos en cada hoja variará, por lo que tendré que seleccionar los datos en cada hoja usando algo como esto:

Rango ("A1"). Seleccionar
Rango (Selección, Selección.Terminal (xlAbajo)). Seleccione
Rango (Selección, Selección. Fin (xlToRight)). Seleccionar


Los nombres de las hojas de archivo son Donaciones, Servicios, Seguros, Automóvil, Otros gastos, etc.

Gracias de antemano.
Este comentario fue minimizado por el moderador en el sitio
Hola Andrew Shahan,
El siguiente código de VBA puede resolver su problema. Después de ejecutar el código y seleccionar una carpeta, el código coincidirá automáticamente con la hoja de trabajo por nombre y pegará los datos en la hoja de trabajo del mismo nombre en el libro de trabajo maestro.
Sub Merge2MultiSheets()
'Updated by Extendoffice 20221209
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook As Workbook, xMainBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set xMainBook = ThisWorkbook
    
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            
            Do Until xFileName = ""
            Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)

            For Start = 1 To xBook.Worksheets.Count
                Set xSheet = xBook.Worksheets.Item(Start)
                xSheet.Activate
                xSheetName = xSheet.Name
                xSheet.UsedRange.Copy (xMainBook.Worksheets.Item(xSheetName).Range("A1048576").End(xlUp).Offset(1, 0))
            Next
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
No hay comentarios publicados aquí todavía
Deje sus comentarios
Publicar como invitado
×
Califica esta publicación:
0   Personajes
Ubicaciones sugeridas

Seguinos

Copyright © 2009 - www.extendoffice.com. | Reservados todos los derechos. Energizado por ExtendOffice, | Mapa del Sitio
Microsoft y el logotipo de Office son marcas comerciales o marcas comerciales registradas de Microsoft Corporation en los Estados Unidos y / o en otros países.
Protegido por Sectigo SSL