Copier un liste sur plusieurs classeur a la fois

Public Sub test()

Dim folderPath As String
folderPath = [COLOR="Red"][I]le chemin de ton dossier[/I][/COLOR]


Dim myFso
Set myFso = CreateObject("Scripting.FileSystemObject")

'si le dossier n'existe pas, on quitte la macro
If Not myFso.FolderExists(folderPath) Then MsgBox "le dossier """ & folderPath & """ n'existe pas": Exit Sub
Dim myFold
'ouvrir le dossier
Set myFold = myFso.GetFolder(folderPath)

Application.ScreenUpdating = False
Dim curFile As File, curWbk As Workbook
'pour chaque fichier du dossier
For Each curFile In myFold.Files
    'si l'extension est bien "xls"
    If Split(curFile.Name, ".")(UBound(Split(curFile.Name, "."))) = "xls" Then
        'on ouvre le classeur
        Set curWbk = Application.Workbooks.Open(curFile.Path)
        
        
        [B]'tu fais ton code ici (pour copier ta liste) ----------------------------------------------------[/B]
        curWbk.Sheets("Liste").Range("A1").Value = "tototiti"
        [B]'------------------------------------------------------------------------------------------------[/B]
        
        
        'on ferme le classeur
        curWbk.Close True
    End If
Next curFile
Application.ScreenUpdating = True

End Sub

Sub Macro3()
With Application
.AddCustomList ListArray:=Array("TOTO", "TATA", "TUTU", "TITI", "TETE")
End With
End Sub