Macro compilation

Hello tout le monde !

J'ai encore un petit soucis alors j'espère que vous pourrez m'aider à nouveau !

Dans un dossier j'ai plein de fichier du type suivant :

Et via le code de compilation suivant je devrais récupérer toutes les données situé dans l'onglet "recap" :

Option Explicit

    Dim MonRepertoire As String, onglet As String, autofin As Boolean, lignedeb As String, lignefin As String, coldeb As String, colfin As String, destinataire, i As Integer, dimTab As Integer, depuis As Integer
    Dim TabEnTete() As String
Sub select_repertoire()
    Dim Repertoire As String

    Dim CodeScript As String, CR As String
CR = Chr$(13)
CodeScript = "tell application ""Finder"""
CodeScript = CodeScript & CR & "set chemin to choose folder with prompt ""Sélectionnez le dossier à traiter"""
CodeScript = CodeScript & CR & "set chemin to chemin as string"
CodeScript = CodeScript & CR & "end tell"
Repertoire = MacScript(CodeScript)
    If Repertoire <> "" Then
        Range("repertoire").Value = Repertoire
    End If
End Sub
Sub compiler()
Application.ScreenUpdating = False
    ' mise en place des paramètres du programme
    MonRepertoire = Range("repertoire").Value

    Set destinataire = ActiveWorkbook

    coldeb = Range("coldeb").Value
    colfin = Range("colfin").Value
    lignedeb = Range("lignedeb").Value
    lignefin = Range("lignefin").Value
    onglet = Range("onglet").Value
    autofin = False
    If lignefin = "" Then autofin = True
    dimTab = 0

    If Range("debentete").Value <> "" Then
        dimTab = (Cells(Range("debentete").Row, Range("debentete").Column - 1).End(xlToRight).Column - Range("debentete").Column + 1)
        ReDim TabEnTete(dimTab - 1)
        For i = 0 To UBound(TabEnTete)
            TabEnTete(i) = Cells(Range("debentete").Row, Range("debentete").Column + i).Value
        Next i
    End If

    ' effacement des données

    Sheets("compilation").Activate
    Range("A2").CurrentRegion.Select
    Selection.Clear

    ' place le curseur au début
    Range("A2").Offset(0, dimTab).Select
    depuis = ActiveCell.Row

    ' lecture du répertoire
    MsgBox "Début de la compilation ..."
    ListeFichiers MonRepertoire
    MsgBox "Fin de la compilation ..."
    Application.ScreenUpdating = True
End Sub
Sub ListeFichiers(Repertoire As String)

    If Repertoire = "" Then
        MsgBox " Choisissez le répertoire !"
        Exit Sub
    End If
    Dim lefichier As String, lechemin As String

    lechemin = Repertoire
    Dim CodeScript As String, CR As String, gu As String, chemin As String
CR = Chr$(13)
gu = Chr$(34)
CodeScript = CodeScript & CR & "tell application""finder"""
CodeScript = CodeScript & CR & "set chemin to " & gu & Repertoire & gu
CodeScript = CodeScript & CR & "end tell"

CodeScript = CodeScript & CR & "set un_dossier to chemin"

CodeScript = CodeScript & CR & "set un_dossier to chemin as alias"

CodeScript = CodeScript & CR & "tell application ""Finder"""
CodeScript = CodeScript & CR & "set i to 1"
CodeScript = CodeScript & CR & "set les_fichiers to files of un_dossier"
CodeScript = CodeScript & CR & "repeat with chaque_fichier in les_fichiers"

CodeScript = CodeScript & CR & "set nom to name of chaque_fichier"
CodeScript = CodeScript & CR & "set extens to document file nom in un_dossier"
CodeScript = CodeScript & CR & "set lextension to name extension of extens"
CodeScript = CodeScript & CR & "set lechemin to un_dossier as string"
CodeScript = CodeScript & CR & "if lextension = ""xlsx"" or lextension = ""xlsm"" or lextension = ""xls"" then"
CodeScript = CodeScript & CR & "tell application ""Microsoft Excel"""
CodeScript = CodeScript & CR & "activate (select sheet ""compilation"")"
CodeScript = CodeScript & CR & "set value of cell (""L"" & i) to lechemin"
CodeScript = CodeScript & CR & "set value of cell (""M"" & i) to nom"
CodeScript = CodeScript & CR & "end tell"
CodeScript = CodeScript & CR & "set i to i + 1"
CodeScript = CodeScript & CR & "end if"

CodeScript = CodeScript & CR & "end repeat"
CodeScript = CodeScript & CR & "set les_dossiers to folders of un_dossier"
CodeScript = CodeScript & CR & "repeat with chaque_dossier in les_dossiers"
CodeScript = CodeScript & CR & "set un_dossier to Chaque_dossier"

CodeScript = CodeScript & CR & "set les_fichiers to files of un_dossier"
CodeScript = CodeScript & CR & "repeat with chaque_fichier in les_fichiers"
CodeScript = CodeScript & CR & "set nom to name of chaque_fichier"
CodeScript = CodeScript & CR & "set extens to document file nom in un_dossier"
CodeScript = CodeScript & CR & "set lextension to name extension of extens"
CodeScript = CodeScript & CR & "set lechemin to un_dossier as string"
CodeScript = CodeScript & CR & "if lextension = ""xlsx"" or lextension = ""xlsm"" or lextension = ""xls"" then"
CodeScript = CodeScript & CR & "tell application ""Microsoft Excel"""
CodeScript = CodeScript & CR & "activate (select sheet ""compilation"")"
CodeScript = CodeScript & CR & "set value of cell (""L"" & i) to lechemin"
CodeScript = CodeScript & CR & "set value of cell (""M"" & i) to nom"
CodeScript = CodeScript & CR & "end tell"
CodeScript = CodeScript & CR & "set i to i + 1"
CodeScript = CodeScript & CR & "end if"
CodeScript = CodeScript & CR & "end repeat"
CodeScript = CodeScript & CR & "end repeat"
CodeScript = CodeScript & CR & "end tell"
MacScript (CodeScript)

    i = 1
    Do While i > 0
    Worksheets("compilation").Activate
        lechemin = Range("L" & i)
        lefichier = Range("M" & i)

        If lefichier <> "" Then
    ' boucle sur tous les fichiers du répertoire
            If Left(lefichier, 2) <> "~$" Then

                Workbooks.Open Filename:=lechemin & lefichier
                If FeuilleExiste(onglet) Then
                    Sheets(onglet).Select

                    ' trouve la dernière ligne
                    Range(coldeb & (lignedeb - 1)).End(xlDown).Select
                    If autofin Then lignefin = ActiveCell.Row

                    ' sélectionne la région à copier
                    Range(coldeb & lignedeb & ":" & colfin & lignefin).Select

                    ' copie la région
                    Selection.Copy

                    ' change de fichier
                    destinataire.Activate
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False

                    If Range("debentete").Value <> "" Then
                        For i = 1 To UBound(TabEnTete)
                            Workbooks(lechemin & lefichier).Activate
                            Range(TabEnTete(i)).Copy
                            destinataire.Activate
                            Range("A" & depuis & ":" & "A" & (depuis + lignefin - lignedeb)).Offset(0, i).Select
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            Application.CutCopyMode = False
                        Next i
                    End If

                If Range("pasapas").Value = "OUI" Then
                   MsgBox ("Fin de recopie de """ & lefichier & """ : " & lignefin - lignedeb + 1 & " lignes recopiées !")
                End If

                End If

                ' ferme le fichier sans faire de changement
               Workbooks(lefichier).Activate
                ActiveWindow.Close False

                ' place le curseur sous les données
                destinataire.Activate
                Cells(depuis + lignefin - lignedeb + 1, dimTab + 1).Select
                ' sauvegarde cette ligne pour recopie des en-têtes en colonne
                depuis = ActiveCell.Row

                    Else
                        MsgBox "La feuille """ & onglet & """ du fichier """ & lefichier & """ est nouvelle et ne sera pas reprise !"
                    End If
        Else
        Range("L" & ":M").Select
                Selection.Clear
        Exit Sub
        End If
        i = i + 1
        Loop

End Sub
Function FeuilleExiste(NomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(NomFeuille) Is Nothing
Err_FeuilleExiste:
End Function

Or cela ne marche pas, il ne récupère que la première ligne et je ne comprends pas pourquoi... Une idée ?

(le code est en apple script j'espère que ça gêne pas trop mais je tente ma chance ici car vous êtes beaucoup plus réactif et efficace que les sites de mac)

J'espère que vous avez compris mon problème et que vous pourrez m'aider !

merci

Personne n'a une idée ? :p

Toujours pas ?