Copiar la misma hoja de varios archivos en otra hoja de otro workbook

[Santino]

Qué tal, estoy teniendo problemas nuevamente queriendo copiar la misma hoja de diferentes archivos almacenados en una carpeta, lo que hace la macro es encontrar la última fila disponible para pegar la info del archivo 2, y así sucesivamente pero me aparece el error "1004" de que la hoja en la que quiero pegar el archivo no tiene el mismo número de celdas.

Mi objetivo es hacer un archivo Master con la información de la primera hoja de todos los archivos dentro de la carpeta.

Este es mi código:

Sub MasterSTS()
Dim Carpeta As String
Dim Examinar As Object
'--
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Examinar = Application.FileDialog(msoFileDialogFolderPicker)
With Examinar
   If .Show = -1 Then
       Carpeta = .SelectedItems.Item(1)
       RecorreArchivos Carpeta
   End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.StatusBar = False
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
'--
Set LDestino = ActiveWorkbook
Set Destino = ActiveSheet
Set Lcopia = Workbooks.Open(Archivo)
Sheets("SoloMexico").Range("A3:L" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy
Destino.Range("A" & Destino.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues

ActiveWorkbook.Close SaveChanges:=True
End Sub

Al remover la línea de :

ActiveWorkbook.Close 

Funciona sin ningún problema, no me aparece ningún error ni nada pero me deja todos los archivos abiertos de donde copié la información y me gustaría que al terminar de ejecutar la macro, me cierre todos los libros abiertos.

No entiendo porque al remover esa línea en específico todo funciona correctamente, espero me puedan ayudar.

[Haplox]

Hace 15 horas, Santino dijo:

Sheets("SoloMexico").Range("A3:L" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy Destino.Range("A" & Destino.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues

Si eso dos rangos no son iguales en tamaño, no te va a dejar. <es el comportamiento de Excel. Si lo quieres copiar al final, simplemente selecciona esa celda y pega.

SI lo quieres pegar al principio, pues elige esa celda y copia

[Santino]

Me lo pega en la última fila disponible del archivo, para que así se vayan pegando de forma seguida, por eso hice esas dos líneas de código, entonces mi pregunta cambiaría a cómo podría aplicar el copiado y pegado de varios archivos en la última fila disponible de la hoja "SoloMexico" @Haplox

[overdrive]

Cuidado con el pastespecial y seleccionar un rango donde copiar ya que puedes crear un bucle infinito (te copia el rango sucesivamente hasta acabar en la ultima fila). La función PasteSpecial es bastante puñetera, y como te han recomendado es mejor expresar una única celda para iniciar el pegado.

Ese tipo de errores suele pasar cuando estás usando un estilo de codificación sin referenciar de forma explicita las variables, y es complicado ver el problema. Prueba con esto que he codificado, que no he podido comprobar porque no dispongo de los archivos que posees. Cuando abres dos libros y manipulas objetos entre ellos, sin una referenciación correcta de variables te puede dar un sincope.

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" & .Rows.Count).End(xlUp).Row
        .Sheets("SoloMexico").Range("A3:L" & lFilaCopia).Copy
    End With
    
    With Destino
        lFilaCopia = .Cells(.Rows.Count).End(xlUp).Row + 1
        .Range("A" & lFilaCopia).PasteSpecial xlPasteValues
    End With
    
    Lcopia.Close
    LDestino.Close SaveChanges:=True
End Sub

 

[Santino]

@overdriveMe arrojó el error '438' "El objeto no admite esta propiedad o método" en la línea marcada en negritas:

 With Lcopia
        lFilaCopia = .Sheets(1).Range("A" & .Rows.Count).End(xlUp).Row
        .Sheets("SoloMexico").Range("A3:L" & lFilaCopia).Copy
    End With

[overdrive]

Uy, vaya gazapo. Lcopia es un libro y como tal no admite invocar directamente .Rows.Count, por lo que cambia el código a:

With Lcopia
        lFilaCopia = .Sheets(1).Range("A" & .Sheets(1).Rows.Count).End(xlUp).Row
        .Sheets("SoloMexico").Range("A3:L" & lFilaCopia).Copy
    End With

De todas maneras, al no tener los archivos interprete lo que quieres hacer con el código que leí pero es posible que no se adapte fielmente a lo que necesitas. Si quieres postea un ejemplo en un libro y adjúntalo. Saludos.