Hello les collègues,
je ne sais pas ou poster ça, alors je la mets là. J’ai développé avec l’aide de chatgpt 
une macro qui range les Step dans un dossier avec son nom.`. si vous avez un dossier avec une cinquantaine de Step; vous lancez la macro depuis un fichier Excel dans le dossier ou se trouvent tous les Step et elle crée un dossier pour chaque STEP avec le nom de celui-ci
ça peut toujours servir
Option Explicit
Sub RepertorierFichiers()
Dim CheminDossier As String
Dim Fichier As String
Dim NouveauDossier As String
Dim FSO As Object ' FileSystemObject
' Obtenir le chemin du dossier actuel
CheminDossier = ThisWorkbook.Path & "\"
' Vérifier si le dossier existe
If Dir(CheminDossier, vbDirectory) = "" Then
MsgBox "Le dossier spécifié n'existe pas."
Exit Sub
End If
' Désactiver les mises à jour pour accélérer le processus
Application.ScreenUpdating = False
' Créer une instance du FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
' Boucle à travers tous les fichiers du dossier actuel avec l'extension STP/STEP
Fichier = Dir(CheminDossier & "*.stp")
Do While Fichier <> ""
' Ignorer les dossiers
If Not (GetAttr(CheminDossier & Fichier) And vbDirectory) = vbDirectory Then
' Extraire le nom du fichier sans extension
NouveauDossier = Left(Fichier, InStrRev(Fichier, ".") - 1)
' Limiter le nom du dossier à 100 caractères maximum
If Len(NouveauDossier) > 100 Then
NouveauDossier = Left(NouveauDossier, 100)
End If
' Créer un nouveau dossier s'il n'existe pas déjà
If Not FolderExists(CheminDossier & NouveauDossier) Then
On Error Resume Next
FSO.CreateFolder CheminDossier & NouveauDossier
On Error GoTo 0
' Vérifier si le dossier a été créé avec succès
If Not FolderExists(CheminDossier & NouveauDossier) Then
MsgBox "Impossible de créer le dossier : " & CheminDossier & NouveauDossier
Exit Sub
End If
End If
' Copier le fichier vers le nouveau dossier
On Error Resume Next
FSO.CopyFile CheminDossier & Fichier, CheminDossier & NouveauDossier & "\" & Fichier
On Error GoTo 0
' Vérifier si la copie a réussi
If Not FileExists(CheminDossier & NouveauDossier & "\" & Fichier) Then
MsgBox "Impossible de copier le fichier : " & CheminDossier & Fichier
Else
' Supprimer le fichier d'origine
On Error Resume Next
FSO.DeleteFile CheminDossier & Fichier
On Error GoTo 0
End If
End If
' Passer au fichier suivant
Fichier = Dir
Loop
' Libérer l'objet FileSystemObject
Set FSO = Nothing
' Activer les mises à jour
Application.ScreenUpdating = True
MsgBox "Le processus est terminé !"
End Sub
Function FolderExists(FolderPath As String) As Boolean
On Error Resume Next
FolderExists = (GetAttr(FolderPath) And vbDirectory) = vbDirectory
On Error GoTo 0
End Function
Function FileExists(FilePath As String) As Boolean
On Error Resume Next
FileExists = (GetAttr(FilePath) And vbDirectory) <> vbDirectory
On Error GoTo 0
End Function
