Copier onglet de plusieurs classeurs / Chemin

Bonjour à tous,

Je me permets de solliciter une nouvelle fois votre aide car, après moultes recherches tant sur la toile que dans mes (maigres) connaissances en vba, je n'arrive pas à résoudre mon problème.

Je m'explique :

J'ai un répertoire contenant X classeurs Excel. Ces derniers se présentent tous de la même manière et possèdent donc tous un onglet "RECAP". Ils sont tous protégés par mots de passe.

Je souhaite effectuer une boucle pour copier l'onglet RECAP de chaque classeur dans un nouveau classeur mais hors du répertoire, ce dernier fichier étant nommé "Synthèse".

Pour le mot de passe, je peux l'enlever sans trop de soucis grâce à ceci :

Sub UnProt() 
    Dim Chemin As String, Fichier As String 
    Dim Feuille As Worksheet 
    Chemin = ThisWorkbook.Path & "\"
    Fichier = Dir(Chemin & "*.xls") 
    'boucle sur tous les classeurs 
    Do While Len(Fichier) > 0 
        If Fichier <> ThisWorkbook.Name Then 
            'ouvre le fichier 
            Workbooks.Open Filename:=Chemin & Fichier 
            'boucle sur chaque feuille 
            For Each Feuille In ActiveWorkbook.Worksheets 
                'déprotège 
                Feuille.Unprotect Password:="mon mdp"
            Next 
            ActiveWorkbook.Save 
            ActiveWorkbook.Close 
        End If 
        Fichier = Dir() 
    Loop 
End Sub

Mais je n'arrive pas à implémenter mon étape de Copy/Paste...

Je ne sais pas si ôter la protection est nécessaire, mais je peux le faire.

En revanche il me faut vos lumières pour la partie copier/coller.

D'avance, merci beaucoup.

JB

Bonjour,

adaptation à tester ...

Sub UnProt()
    Dim Chemin As String, Fichier As String
    Dim Feuille As Worksheet
    Set twb = ThisWorkbook
    Chemin = ThisWorkbook.Path & "\"
    Fichier = Dir(Chemin & "*.xls")
    'boucle sur tous les classeurs
    Do While Len(Fichier) > 0
        If Fichier <> ThisWorkbook.Name Then
            'ouvre le fichier
            Set wba = Workbooks.Open(Filename:=Chemin & Fichier)
            'boucle sur chaque feuille
            For Each Feuille In wba.Worksheets
                'déprotège
                If UCase(Feuille.Name) = "RECAP" Then
                    Feuille.Unprotect Password:="mon mdp"
                    Feuille.Copy after:=twb.Worksheets(Worksheets.Count)
                    Exit For
                End If
            Next
            wba.Close
        End If
        Fichier = Dir()
    Loop
End Sub

En adaptant j'ai réussi! Merci beaucoup pour le morceau manquant !