Rangement des fichiers Xls d'un répertoire avec des sous répertoires

bonjour a tous

voila je cris a l aide car la je sais si une solution existe en codage Vba pour faire cela

j explique un peu mon cas et ce qu' on nous demande ensuite de faire qui va prendre un temps fou a faire a la main avec la souris

j'ai un dossier master qui contient plusieurs dossiers

j explique : Répertoire Gamme , j'ai ensuite Répertoire N1 qui contient des répertoires LEPJ-MNT-N1-0001....0002

Répertoire N2 qui contient des répertoires LEPJ-MNT-N2-0001....0002....0003...jusqu' a 9999

Répertoire N3 qui contient des répertoires LEPJ-MNT-N3-0001....0002....0003...jusqu' a 9999

les répertoires contient un fichier master nommé identique que les dossiers

jusque la tout va bien

après la partie ce complique ,donc on as ailleurs un répertoires pour un arrêt techniques (GA25) qui as des répertoires prépa fer ;prépa fil; etc... qui lui as plusieurs sous répertoires avec les fichiers en exemple: LEPJ-MNT-N3-0001-GA, LEPJ-MNT-N3-0021-GA etc.. etc...

le but est reprendre les fichiers des répertoires Ga25 d aller dans le répertoire Master de crée le répertoire GA25 de mettre le fichier dedans associer

a condition que le fichier soit dans les répertoires du Ga25\de prep fil\prep fer \etc...

ce qui donnerai

Répertoire N1 qui contient des répertoires LEPJ-MNT-N1-0001\GA25\ le fichier LEPJ-MNT-N1-0001-GA.Xls

Répertoire N2 qui contient des répertoires LEPJ-MNT-N2-0001\GA25\ le fichier LEPJ-MNT-N2-0001-GA.Xls ....0002....0003...jusqu' a 9999

Répertoire N3 qui contient des répertoires LEPJ-MNT-N3-0001....0002....0003...jusqu' a 9999

manip trop compliquer en Vba a mon niveau , j ai pas encore commencer le Vba car je sais pas par ou démarré

si quel quelqu'un a une idée ou peut nous sauver la mise qui nous ferai gagné un temps considérables sur cette tache car on ai vraiment déborder , sur la préparation de l arrêt technique

en vous remerciant d avance

bonjour,

pour le moment, je ne comprends pas bien où vos fichiers se trouvent. Avec la macro dans la PJ, je sais les localiser (quand le chemin est bon). Pouvez-vous me donner votre résultat de cette macro, donc la nouvelle feuille. J'éspère que le nombre de lignes ne sera pas excessif. Dans ce cas et/ou s'il y a des données sensibles, vous pouvez supprimer ces lignes. Donc votre réponse sera : autant de lignes et par exemple le fichier qui se trouve dans la ligne 50, je veux la déplacer vers ... .

Dans la PJ, feuille "Blad3", vous voyez le résultat chez moi avec seulement 40 lignes (le reste est supprimé).

Bonjour a Tous

cette nuit, j'ai eu des idée et un début code

mais le code lui déplace le fichier lorsque je voudrais qu il copy

ensuite j ai rajouter des colonnes répertoire sources et le répertoire a créer

si quelqu'un a une idée et m aidé a revoir le code de la Vba

salut BSALV

j ai testé ta macro ca donne simplement arborescence

du coup j ai fait celle la source a trier et celle qui est la cible

le but et de copier les LEPJ-MNT-N1-0003-GA.XLS...dans le répertoire LEPJ-MNT-N1-0003-GA en créant le sous répertoire nommé (GA25) et mettre le fichier LEPJ-MNT-N1-0003-GA.XLS en copie pour une ligne

comme sur model de l onglet Tag_fichiers_dossiers

je te joint le fichier

cordialement

on a

\\SRV0744\commun\OPE-MNT-Doc-STD\Technique\Gestion des gammes et des plans de maintenance\Dossier Gammes\Gammes N1 N2 N3\GAMMES N1\LEPJ-MNT-N1-002\LEPJ-MNT-N1-002-GA.xls

on crée quoi comme sous répertoire

\\SRV0744\commun\OPE-MNT-Doc-STD\Technique\Gestion des gammes et des plans de maintenance\Dossier Gammes\Gammes N1 N2 N3\GAMMES N1\LEPJ-MNT-N1-002\GA25 ??

si ce sous répertoire existe déjà, il ne faut plus le créer ou il faut arrêter

si le fichier existe déjà dans le sous répertoire, il faut l'écraser ou il faut rien faire ?

ceci donne uniquement les "GA.XLS..."

Sub M_Test()

     s0 = "\\SRV0744\commun\OPE-MNT-Doc-STD\Technique\Gestion des gammes et des plans de maintenance\Dossier Gammes\Gammes N1 N2 N3" 'votre chemin
     's0 = ThisWorkbook.Path
     sn = Filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & s0 & """ /b /s ").StdOut.ReadAll, vbCrLf), "ga.xls", 1, 1)
     MsgBox UBound(sn) & " fichiers"
     With Worksheets.Add
          With .Range("A1")
               .Resize(UBound(sn) + 1).Value = Application.Transpose(sn)
               .EntireColumn.AutoFit
          End With
     End With
End Sub

oui effectivement

il faut crée le sous répertoire Ga25 des dossier \\SRV0744\commun\OPE-MNT-Doc-STD\Technique\Gestion des gammes et des plans de maintenance\Dossier Gammes\Gammes N1 N2 N3\GAMMES N1\LEPJ-MNT-N1-002\GA25

si le dossier existe deja ,on ne l ecrase pas , mais mettre une notification du coter moulinette dossier existant non mis a jour

les autre qui seront copier notifier ok

faire les lien avec le tableau et les création sous dossier avec le tableau

la colonne A correspond les répertoires sources file

la colonne B le nom du fichier a copier avec extension (xlsm,xls,....)

la colonne C le nom du sous dossier A crée

la colonne D les répertoires de destination avec le sous dossier de la colonne C

la colonne E le statu de la copie ranger/non ranger/dossier existant

voila en espérant c'est plus clair

j ai repris le format du tableau

refait les lignes de codes

il manque juste le retour d information qu'il a copier le fichier dans le Répertoire

après je sais pas s il y a possibilité lors d analyse des répertoires de dégrouper automatiquement au lieux de faire a la main

Sub CopierFichier()

Dim fso As Object
    Dim Source As String
    Dim Destination As String
    Dim LastRow As Long
    Dim i As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Source = Range("B" & i).Value & Range("A" & i).Value
Destination = Range("C" & i).Value

If Range("A" & i).Value <> "" And Source <> "" And Destination <> "" Then
Set fso = VBA.CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(Left(Destination, Len(Destination) - 1)) Then
    fso.CreateFolder Destination
    Destination = Destination & "\"
End If

Call fso.CopyFile(Source, Destination)
End If
Next i

End Sub

re,

bon, je n'ai pas compris le sous répertoire de la destination, mais je vois que vous avez un niveau pour savoir adapter cela. c'est le variable "s1" et la macro "Stef80400"

EDIT : je regarderai votre macro aussi vite que possible

re

regarde le fichier ci dessus tu va comprendre un peut mieux peut être

bonjour

j' ai avancer sur le fichier

regarde ce qui est possible de faire de faire en Automatique

car dégrouper a la main c'est très long

il faudrait diviser le lien des répertoires et le noms du fichier

tu verras sur le fichier comment le résultat final que j ai fait a la main

et faudrait mettre aussi une condition je pense quand j ai un fichier LEPJ-MNT-N1- de mettre la colonne d avant le groupe GAMMES N1\ , LEPJ-MNT-N2- de mettre la colonne d avant le groupe GAMMES N2 , LEPJ-MNT-N3- de mettre la colonne d avant le groupe GAMMES N3

ensuite sur lien fichier exemple: LEPJ-MNT-N2-0225-GA Rev2.xlsx avoir que LEPJ-MNT-N2-0225 dans le tableau en colonne G

Si il y a des PDF de mettre LEPJ-MNT-N2-0225\doc et Si il y a des JPG de mettre LEPJ-MNT-N2-0225\PHOTO

en suite pour la copy on écrase si existant

ensuite il me faudrait le retour de la copy sur le tableau copy savoir si ok ou écraser ou erreur fichier de départ

car une fois au point je vais pouvoir remettre a jour les répertoire sur plusieurs année en arrière la j ai mit \GA24\ pour la création mais après sa va être \GA22\ etc.. selon le répertoire sources des arrêts technique antérieur

ci-joint le fichier retravailler

bon voila j ai avancer sur le codage de la mise en forme

il reste a voir si cela et possible compilé les codes sur un bouton dans l'ordre

et le deuxième bouton pour effectuer la copy et création du répertoire GA 24 ou autre et avoir le retour d'information de la copy si ok ou Non ok

l'écrasement s il y a un fichier existant et autorisé

pour le code copy vers la source ne marche pas pourquoi je sais pas?

es que c est le fait que j ai crée le lien en codage Vba en condition

Sub CopierFichier()

Dim fso As Object
    Dim Source As String
    Dim Destination As String
    Dim lastRow As Long
    Dim i As Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
Source = Range("B" & i).value & Range("A" & i).value
Destination = Range("C" & i).value

If Range("A" & i).value <> "" And Source <> "" And Destination <> "" Then
Set fso = VBA.CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(Left(Destination, Len(Destination) - 1))Then
    fso.CreateFolder Destination 
    Destination = Destination & "\"
End If

Call fso.CopyFile(Source, Destination)
End If
Next i

End Sub