Dim idx As Long
Dim SourceFichier, DestinationFichier, cheminsousdossier, nomsousdossier
Dim lecteur As String
Dim fso As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder
Dim Sousdossier As Scripting.Folder
Dim Fichier As Scripting.File
lecteur = Cells(4, 2).Value
SourceFichier = "C:\Users\BW\Desktop\TEST\"
DestinationFichier = lecteur & ":\Users\BW\Desktop\COPIE\"
nomfichier = "*.pdf"
Set fso = New Scripting.FileSystemObject
Set DossierSource = fso.GetFolder(SourceFichier)
For Each Sousdossier In DossierSource.SubFolders
'idx = idx + 1
'Cells(idx, 10).Value = Sousdossier.Name
'Cells(idx, 11).Value = Sousdossier.Path
cheminsousdossier = Sousdossier.Path
nomsousdossier = Sousdossier.Name
Set Sousdossier = fso.GetFolder(cheminsousdossier)
MkDir (DestinationFichier & nomsousdossier)
For Each Fichier In Sousdossier.Files
fso.CopyFile cheminsousdossier & "\" & nomfichier, DestinationFichier & nomsousdossier & "\"
Next Fichier
Next Sousdossier
For Each Fichier In DossierSource.Files
fso.CopyFile SourceFichier & nomfichier, DestinationFichier
Next Fichier
Set Fichier = Nothing
Set DossierSource = Nothing
Set fso = Nothing
End Sub