Macro pour copier onglet dans un seul fichier

merci pour ta réponse

Cela ne marche pas (j'ai neutralisé le "is" car cela créait une erreur)

Mais là avec le code, il recommence à dupliquer les onglets et mettre un (2)...

Tu sais d'où cela vient?

merci et désolé pour le dérangement

Avec le code suivant, cela fonctionne chez moi !

Sub ListingFichiers()
Application.DisplayAlerts = False
Dim Rep As String, Fichier As String

Rep = Workbooks(ActiveWorkbook.Name).Path & "\"
Fichier = Dir(Rep)
Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
        On Error Resume Next
        Workbooks(Fichier).Activate
        If Err <> 0 Then
        Workbooks.Open Filename:=Rep & Fichier
        On Error GoTo 0
        End If
        For Each ws In ActiveWorkbook.Sheets
            If ws.Name Like "BT*" Then
                For Each wk In Workbooks("BT - Synthesis by domain.xlsm").Sheets
                i = 1 + i
                    If ws.Name = wk.Name Then
                        ws.Cells.Copy
                        wk.[A1].PasteSpecial
                        Else
                    If i = Workbooks("BT - Synthesis by domain.xlsm").Sheets.Count Then
                            ws.Copy After:=Workbooks("BT - Synthesis by domain.xlsm").Sheets(1)
                    End If
                    End If
                Next wk
            End If
        Next ws
        Application.DisplayAlerts = False
        Workbooks(Fichier).Close False
        Application.DisplayAlerts = True
        Fichier = Dir
        Else
        Fichier = Dir
    End If
Loop

For Each wksh In ThisWorkbook.Worksheets
If wksh.Name Like "BT*" Then
    wksh.Cells.Copy
    wksh.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
Next wksh

End Sub

merci

en fait c'est très bizarre car la macro fonctionne parfaitement sauf pour un seul onglet qui s'appelle "BT-DIR Follow-up", pour celui-ci, la macro le duplique 9 fois...

Au pire je supprimerai à la main les onglets en trop mais cela reste quand même un mystère...

tu peux essayer de rajouter une * comme ceci :

Like "*BT*" then

Aux endroits où il y a des lignes comme celle la !