Copiar varios libros de excel en uno
Hola, Gracias por la ayuda de antes... Tengo un nuevo inconveniente!
Tengo 3000 archivos de excel en una carpeta en el disco duro C: llamada VIB, como copio la información de los 3000 archivos en una sola hoja.
Aclaro, cada archivo tiene una sola hoja; y cada hoja tiene como máximo 12 filas diligenciadas.
Tengo 3000 archivos de excel en una carpeta en el disco duro C: llamada VIB, como copio la información de los 3000 archivos en una sola hoja.
Aclaro, cada archivo tiene una sola hoja; y cada hoja tiene como máximo 12 filas diligenciadas.
Respuesta de dryiceman
1
Fácil, nada más ten en cuenta, que mientras tengas abierto un libro con varias hojas toma más memoria de tu PC lo que la hará lenta.
Si todas los libros están en un mismo folder o carpeta es mejor como en el ejemplo siguiente.
Esta macro copia la primera hoja de cada archivo de excel que
se encuentra en C:\VIB\ al libro donde se corre la macro
El nombre de la hoja es el nombre del libro
.
Sub CopySheet()
Dim basebook As Workbook
Dim mybook As Workbook
Dim i As Long
Application.ScreenUpdating = False ' Esto para que no muestre lo que hace la macro, mas rapida
With Application.FileSearch
.NewSearch
.LookIn = "C:\VIB" ' Aqui esta el folder donde deben de estar los libros
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
ActiveSheet.Name = mybook.Name
mybook.Close
Next i
End If
End With
Application.ScreenUpdating = True
End Sub
Si todas los libros están en un mismo folder o carpeta es mejor como en el ejemplo siguiente.
Esta macro copia la primera hoja de cada archivo de excel que
se encuentra en C:\VIB\ al libro donde se corre la macro
El nombre de la hoja es el nombre del libro
.
Sub CopySheet()
Dim basebook As Workbook
Dim mybook As Workbook
Dim i As Long
Application.ScreenUpdating = False ' Esto para que no muestre lo que hace la macro, mas rapida
With Application.FileSearch
.NewSearch
.LookIn = "C:\VIB" ' Aqui esta el folder donde deben de estar los libros
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
ActiveSheet.Name = mybook.Name
mybook.Close
Next i
End If
End With
Application.ScreenUpdating = True
End Sub
