XL 2010 Mise a jour d'un fichier dans tous les sous dossiers

Bens7 · 8 Mai 2017

Bonjour le forum !
Alors voila après moulte recherche (Google+Forum... ect...) et de surcoût novice je fait appel a vos lumière!
j'ai un bon de commande que mes employées remplisse (c'est le même pour tous ) mais defois je fait des mise a jours dessus
et j'ai créer un bouton qui sauvegarde dans les sous dossiers présent sur chaque poste du réseaux :

VB:

Sub miseajour()

On Error Resume Next

Sheets("Feuil1").Activate
ActiveWorkbook.SaveCopyAs "\\MON-PC\RESEAUX\POSTE 3\MARGUERITE\FORMULAIRE.xlsm"
ActiveWorkbook.SaveCopyAs "\\MON-PC\RESEAUX\POSTE 3\SERGE\FORMULAIRE.xlsm"
ActiveWorkbook.SaveCopyAs "\\MON-PC\RESEAUX\POSTE 4\JEAN\FORMULAIRE.xlsm"
ActiveWorkbook.SaveCopyAs "\\MON-PC\RESEAUX\POSTE 5\BEN\FORMULAIRE.xlsm"
ActiveWorkbook.SaveCopyAs "\\MON-PC\RESEAUX\POSTE 5\FABRICE\FORMULAIRE.xlsm"

'bref ya une quinzaine de poste et entre 1 a 2 dossiers par poste qui change de nom a chaque fois

MsgBox ("FORMULAIRE MIS A JOUR")

ActiveWorkbook.Close savechanges:=True

End Sub

j;aimerais en faite que ma macro (sans definir a chaque fois le nom de l'employe (MARGUERITE, SERGE,JEAN...ect...)
enregistre une copie dans tous les deuxième sous dossiers présent dans RESEAUX ou le dossier commence par POSTE .... (donc ceux présent dans les dossiers POSTE 1, POSTE 2, POSTE 3...ect...)
Voila chui désolé mais je peux pas mettre de fichier vu que faut que vous mette toute arborescence du dossier RESEAUX ....

Merci a tous ! c'est vraiment important car ca bougea chaque fois et j;'en peux plus lollll

Bens7 · 9 Mai 2017

Petit up ?
Mise a jour d'un fichier dans un 2eme sous dossier ?

Bens7 · 10 Mai 2017

job75 · 10 Mai 2017

Bonjour,

Il vous a fallu 12 jours pour revenir sur ce fil hi hi hi :

https://www.excel-downloads.com/threads/filtre-suivant-une-collone-autre-feuil.20017119/

et on ne sait toujours pas si pour vous c'est du lard ou du cochon.

Bens7 · 10 Mai 2017

Ho nan croyais moi lolll !! J'aprecie énormément le soutien du forum c'est juste que suite a un déménagement du coup je n'ai pas eu le temps de tester ...loll

Par contre pour ce su jet ci :
https://www.excel-downloads.com/thr...fichier-dans-tous-les-sous-dossiers.20017361/

alors la oui je peut tester tous de suite mais malheuresement pas reponsse :-(

job75 · 10 Mai 2017

Re,

Code:

Sub miseajour()
Dim chemin$, ext$, fso As Object, f As Object, sf As Object
Sheets("Feuil1").Activate
chemin = "\\MON-PC\RESEAUX\" 'ThisWorkbook.Path & "\" 'à adapter éventuellement
ext = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "."), 5)
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(chemin).SubFolders
  If UCase(f.Name) Like "POSTE*" Then
    For Each sf In f.SubFolders
      ThisWorkbook.SaveCopyAs chemin & f.Name & "\" & sf.Name & "\FORMULAIRE" & ext
  Next sf
  End If
Next f
MsgBox "FORMULAIRE MIS A JOUR"
If Not ThisWorkbook.Saved Then ThisWorkbook.Save
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub

Edit : ajouté le calcul de l'extension (ext) par sécurité.

Il faudra combien de temps avant que vous n'accusiez réception ?

A+

Bens7 · 11 Mai 2017

Ho bah la chui rapide ! j'en pouvez plus manuelement ! hihihi
Que dire parfait ... voial ya pas de mot !
Juste j;ai pas compris : Edit : ajouté le calcul de l'extension (ext) par sécurité. ?
Mais ca marche de toute facon

job75 · 11 Mai 2017

Re,

Le calcul de l'extension permet d'utiliser un fichier .xlsm ou .xls.

A+

XL 2010 Mise a jour d'un fichier dans tous les sous dossiers

Bens7

XLDnaute Impliqué

Bens7

XLDnaute Impliqué

Bens7

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Bens7

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Bens7

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Discussions similaires