¿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 :
3. presione el F5 clave para ejecutar el código.
4. En la apertura Explorar 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
Mejore sus habilidades de Excel con Kutools for Excel y experimente la eficiencia como nunca antes. Kutools for Excel ofrece más de 300 funciones avanzadas para aumentar la productividad y ahorrar tiempo. Haga clic aquí para obtener la función que más necesita...
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!