Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
A better way to browse. Learn more.
A full-screen app on your home screen with push notifications, badges and more.
Este tema está ahora archivado y está cerrado a más respuestas.
Qué tal, estoy intentando agregar la hoja de "SoloMexico" de varios libros a otro libro de excel, el problema que tengo es que sólo me está agregando el primer libro de la carpeta, he estado un rato intentando arreglarlo sin éxito, adjunto el código que estoy utilizando:
Public Sub TLD_IniciarMacro() With Application .ScreenUpdating = False .EnableEvents = False .CutCopyMode = False .DisplayAlerts = False End With ActiveSheet.DisplayPageBreaks = False End Sub Public Sub TLD_FinalizarMacro() With Application .DisplayAlerts = True .EnableEvents = True .CutCopyMode = False .ScreenUpdating = True .StatusBar = False End With End Sub Sub MasterSTS() Dim Carpeta As String Dim Examinar As Object TLD_IniciarMacro Set Examinar = Application.FileDialog(msoFileDialogFolderPicker) With Examinar If .Show = -1 Then Carpeta = .SelectedItems.Item(1) RecorreArchivos Carpeta End If End With TLD_FinalizarMacro MsgBox "Proceso terminado" End Sub Private Sub RecorreArchivos(NombreCarpeta As String) Dim Archivos As Object Dim Carpeta As Object Dim Archivo As Object '-- Set Archivos = CreateObject("Scripting.FileSystemObject") Set Carpeta = Archivos.GetFolder(NombreCarpeta) For Each Archivo In Carpeta.Files Application.StatusBar = Archivo.Name CopiarArchivo Archivo.Path Next End Sub Private Sub CopiarArchivo(Archivo As String) Dim Lcopia As Workbook Dim LDestino As Workbook Dim Destino As Worksheet Dim lFilaCopia As Long '-- Set LDestino = ActiveWorkbook Set Destino = LDestino.ActiveSheet Set Lcopia = Workbooks.Open(Archivo) With Lcopia lFilaCopia = .Sheets(1).Range("A" & .Sheets(1).Rows.Count).End(xlUp).Row .Sheets("SoloMexico").Range("A2:L" & lFilaCopia).Copy End With With Destino lFilaCopia = .Cells(.Rows.Count).End(xlUp).Row + 1 .Range("A2" & lFilaCopia).PasteSpecial xlPasteValues End With Lcopia.Close LDestino.Close SaveChanges:=True End SubLa carpeta que recorre la macro contiene 6 archivos por el momento, y sólo me está agregando el primer archivo, los demás los omite y ya no los agrega.