Merci de ton retour, j'ai essayé ce code mais il bloque sur la ligne indiquée en noire
Sub DeplacerSousRepertoires()
Dim SourceRootPath As String
Dim DestinationRootPath As String
Dim FSO As Object
Dim SourceRootFolder As Object
Dim SubRootFolder As Object
Dim SubSubFolder As Object
SourceRootPath = "D:\TEMP\"
DestinationRootPath = "D:\NEW\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceRootFolder = FSO.GetFolder(SourceRootPath)
' Parcourt tous les sous-répertoires dans le dossier source
For Each SubRootFolder In SourceRootFolder.SubFolders
' Parcourt tous les sous-répertoires dans chaque sous-répertoire
For Each SubSubFolder In SubRootFolder.SubFolders
' Déplace le sous-répertoire vers la destination
FSO.MoveFolder SubSubFolder.Path, DestinationRootPath & SubSubFolder.Name
Next SubSubFolder
Next SubRootFolder
Set SourceRootFolder = Nothing
Set FSO = Nothing
MsgBox "Déplacement des sous-répertoires terminé !"
End Sub
