¿Cómo recorrer libros de trabajo en un directorio y copiar datos en una hoja maestra en Excel?
Supongamos que tienes varios libros de Excel en una carpeta y necesitas recorrer todos estos archivos para copiar datos de un rango específico en una hoja de cálculo consistente (por ejemplo, Hoja1) en una hoja maestra. Esta guía proporciona una solución VBA detallada para agilizar este proceso en Excel.
Recorre libros de trabajo en un directorio y copia datos en una hoja maestra con código VBA
Recorre archivos en un directorio y copia datos en una hoja maestra con código VBA
Si deseas copiar datos del rango A1:D4 en todas las hojas Hoja1 de los libros de trabajo en una carpeta específica y pegarlos en una hoja maestra, sigue los siguientes pasos.
1. En el libro donde crearás la hoja maestra, presiona las teclas Alt + F11 para abrir la ventana de Microsoft Visual Basic para Aplicaciones.
2. En la ventana de Microsoft Visual Basic para Aplicaciones, haz clic en Insertar > Módulo. Luego, copia el siguiente código VBA en la ventana de código.
Código VBA: recorrer archivos en una carpeta y copiar 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 SubNota:
3. Presiona la tecla F5 para ejecutar el código.
4. En la ventana Examinar que aparece, selecciona la carpeta que contiene los archivos que recorrerás y luego haz clic en el botón Aceptar. Ver captura de pantalla:
Luego, se crea una hoja de trabajo maestra llamada “Nueva Hoja” al final del libro de trabajo actual. Y los datos en el rango A1:D4 de todas las hojas Hoja1 en la carpeta seleccionada se enumeran dentro de la hoja de trabajo.
Artículos relacionados:
Las mejores herramientas de productividad para Office
Mejora tu dominio de Excel con Kutools para Excel y experimenta una eficiencia sin precedentes. Kutools para Excel ofrece más de300 funciones avanzadas para aumentar la productividad y ahorrar tiempo. Haz clic aquí para obtener la función que más necesitas...
Office Tab incorpora la interfaz de pestañas en Office y facilita mucho tu trabajo
- Habilita la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
- Abre y crea varios documentos en nuevas pestañas de la misma ventana, en lugar de hacerlo en ventanas separadas.
- ¡Aumenta tu productividad en un50% y reduce cientos de clics de ratón cada día!
Todos los complementos de Kutools. Un solo instalador
El paquete Kutools for Office agrupa complementos para Excel, Word, Outlook y PowerPoint junto con Office Tab Pro, ideal para equipos que trabajan en varias aplicaciones de Office.
- Suite todo en uno: complementos para Excel, Word, Outlook y PowerPoint + Office Tab Pro
- Un solo instalador, una licencia: configuración en minutos (compatible con MSI)
- Mejor juntos: productividad optimizada en todas las aplicaciones de Office
- Prueba completa de30 días: sin registro ni tarjeta de crédito
- La mejor relación calidad-precio: ahorra en comparación con la compra individual de complementos