Copiar varios archivos en una sola hoja de otro libro
Hola, primero que nada muchas gracias por su tiempo, gracias a respuestas para otros usuarios he salido de muchos problemas, mi problema es que necesito copiar varias celdas de una hoja pero de igual manera de varios libros y dejarlos en uno solo como base de datos. He intentado hacer una macro hecha por un experto y me da un error de compilaion, que dice "No se ha definido sub o funcion", esto lo marca en la linea que dice: Call ProcessFiles(FS.FoundFiles(i)), ya lo he cambiado como el experto dijo en su momento por Call ProcesaArchivo(FS.FoundFiles(i)) y me sigue enviando el mismo error.
La macro del experto en su menmento y que estoy copiando a mi macro es: Sub ProcesaLote() Dim FS As FileSearch Dim FilePath As String, FileSpec As String Dim i As Integer FilePath = ThisWorkbook.Path & "\" Set FS = Application.FileSearch With FS .LookIn = FilePath .FileName = FileSpec .Execute ' Salir si no se encontraron archivos If .FoundFiles.Count = 0 Then MsgBox "No se encontraron archivos" Exit Sub End If End With ' Recorrer los archivos For i = 1 To FS.FoundFiles.Count Call ProcessFiles(FS.FoundFiles(i)) Next i End Sub De antemano muchas gracias por su ayuda
Hola, perdon si te hice trabajar en vano, he copiado por ahi algunos codigos y me funciono una sola ves, ahora me manda error 1004: no s encontró el archivo. te puedo pegar el codigo que tengo haber si puedes decirme que estoy haciendo mal, como dije antes soy muy novato en macros e inclusive estoy usando cosas que no entiendo al 100. Gracias por tu apoyo, el codigo es: Sub Macro1() ' ' Macro1 Macro ' ' Call ListFiles("D:\Gestion", "*.xls") End Sub Sub ProcesaArchivos(nombre As String) ' Importar Archivos Workbooks.Open Filename:=nombre Range("A1:K32").Select Selection.Copy Windows("RECUPERA.XLSM").Activate Sheets("Hoja2").Select Range("A1").Select ActiveSheet.Paste llenad Windows(strTemp).Activate ActiveWindow.Close End Sub Sub llenad() ' ' llenad Macro ' Dim filaUlt As Long 'esta será la primer fila libre para acumular los datos filaUlt = Sheets("Hoja1").Range("A1048576").End(xlUp).Row + 1 'luego pasarás cada celda de tu hoja 1 a las distintas col de la fila libre Sheets("Hoja1").Cells(filaUlt, 1) = Sheets("Hoja2").Range("j4") Sheets("Hoja1").Cells(filaUlt, 2) = Sheets("Hoja2").Range("B8") Sheets("Hoja1").Cells(filaUlt, 3) = Sheets("Hoja2").Range("g1") Sheets("Hoja1").Cells(filaUlt, 4) = Sheets("Hoja2").Range("B2") Sheets("Hoja1").Cells(filaUlt, 5) = Sheets("Hoja2").Range("g1") Sheets("Hoja1").Cells(filaUlt, 6) = Sheets("Hoja2").Range("B4") Sheets("Hoja1").Cells(filaUlt, 7) = Sheets("Hoja2").Range("j2") Sheets("Hoja1").Cells(filaUlt, 8) = Sheets("Hoja2").Range("j4") Sheets("Hoja1").Cells(filaUlt, 9) = Sheets("Hoja2").Range("j6") Sheets("Hoja1").Cells(filaUlt, 10) = Sheets("Hoja2").Range("j8") Sheets("Hoja1").Cells(filaUlt, 11) = Sheets("Hoja2").Range("b10") Sheets("Hoja1").Cells(filaUlt, 12) = Sheets("Hoja2").Range("h10") Sheets("Hoja1").Cells(filaUlt, 13) = Sheets("Hoja2").Range("b12") Sheets("Hoja1").Cells(filaUlt, 14) = Sheets("Hoja2").Range("b12") Sheets("Hoja1").Cells(filaUlt, 15) = Sheets("Hoja2").Range("b12") Sheets("Hoja1").Cells(filaUlt, 16) = Sheets("Hoja2").Range("i12") Sheets("Hoja1").Cells(filaUlt, 17) = Sheets("Hoja2").Range("i12") Sheets("Hoja1").Cells(filaUlt, 18) = Sheets("Hoja2").Range("b14") Sheets("Hoja1").Cells(filaUlt, 19) = Sheets("Hoja2").Range("e14") Sheets("Hoja1").Cells(filaUlt, 20) = Sheets("Hoja2").Range("e14") Sheets("Hoja1").Cells(filaUlt, 21) = Sheets("Hoja2").Range("h14") Sheets("Hoja1").Cells(filaUlt, 22) = Sheets("Hoja2").Range("b16") Sheets("Hoja1").Cells(filaUlt, 23) = Sheets("Hoja2").Range("k14") Sheets("Hoja1").Cells(filaUlt, 24) = Sheets("Hoja2").Range("j16") Sheets("Hoja1").Cells(filaUlt, 25) = Sheets("Hoja2").Range("c18") Sheets("Hoja1").Cells(filaUlt, 26) = Sheets("Hoja2").Range("e25") Sheets("Hoja1").Cells(filaUlt, 27) = Sheets("Hoja2").Range("g25") Sheets("Hoja1").Cells(filaUlt, 28) = Sheets("Hoja2").Range("j25") Sheets("Hoja1").Cells(filaUlt, 29) = Sheets("Hoja2").Range("d23") Sheets("Hoja1").Cells(filaUlt, 30) = Sheets("Hoja2").Range("j29") Sheets("Hoja1").Cells(filaUlt, 31) = Sheets("Hoja2").Range("h32") Sheets("Hoja1").Cells(filaUlt, 32) = Sheets("Hoja2").Range("k32") End Sub Public Function ListFiles(strPath As String, Optional strFileSpec As String, _ Optional bIncludeSubfolders As Boolean, Optional lst As ListBox) On Error GoTo Err_Handler 'Purpose: List the files in the path. 'Arguments: strPath = the path to search. ' strFileSpec = "*.*" unless you specify differently. ' bIncludeSubfolders: If True, returns results from subdirectories of strPath as well. ' lst: if you pass in a list box, items are added to it. If not, files are listed to immediate window. ' The list box must have its Row Source Type property set to Value List. 'Method: FilDir() adds items to a collection, calling itself recursively for subfolders. Dim colDirList As New Collection Dim varItem As Variant Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders) 'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window. If lst Is Nothing Then For Each varItem In colDirList Debug.Print varItem Next Else For Each varItem In colDirList lst.AddItem varItem Next End If Exit_Handler: Exit Function Err_Handler: MsgBox "Error " & Err.Number & ": " & Err.Description Resume Exit_Handler End Function Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _ bIncludeSubfolders As Boolean) 'Build up a list of files, and then add add to this list, any additional folders Dim strTemp As String Dim colFolders As New Collection Dim vFolderName As Variant Dim nombre As String 'Add the files to the folder. strFolder = TrailingSlash(strFolder) strTemp = Dir(strFolder & strFileSpec) Do While strTemp <> vbNullString nombre = strTemp colDirList.Add strFolder & strTemp strTemp = Dir Call ProcesaArchivos(nombre) Loop If bIncludeSubfolders Then 'Build collection of additional subfolders. strTemp = Dir(strFolder, vbDirectory) Do While strTemp <> vbNullString If (strTemp <> ".") And (strTemp <> "..") Then If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then colFolders.Add strTemp End If End If strTemp = Dir Loop 'Call function recursively for each subfolder. For Each vFolderName In colFolders Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True) Next vFolderName End If End Function Public Function TrailingSlash(varIn As Variant) As String If Len(varIn) > 0& Then If Right(varIn, 1&) = "\" Then TrailingSlash = varIn Else TrailingSlash = varIn & "\" End If End If End Function
Hola gracias me manda el error a la hora que estoy abriendo el libro en la linea: Workbooks.Open Filename:=nombre Gracias
Prueba con esto: Workbooks.OpenText Filename:=nombre
holaa no fijate que me manda lo mismo, cuando ejecuto la macro paso a paso solo me da el nombre del archivo en la variable, no deberia traer la direccion completa? osea D:\gestiones\nombre Gracias por la prontitud
Ingresa primero la ruta: Dim FilePath As String FilePath = "D:\gestiones\nombre" resto_de_código [email protected]
si funciona gracias todavia tengo que trabajar al en el código porque cuendo cierre el mensaje manda un mensaje de si quiero actualizar las formulas al nuevo formato y otro de que lo que si quiero que se borre lo que esta en el portapapeles, aprovechando tu sabras como hacer para que no aparezcan? estoy trabajando con excell 2007 y los archivos son de excell 2003 Pero la primera pregunta esta resuelta, muchas gracias de nuevo
Application.DisplayAlerts = False Para desactivar esos mensajes. Al final del código lo pones a True. [email protected]