Error copiando varias hojas en la hoja de un libro

[Santino]

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 Sub

La 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.