Copier un range dans plusieurs classeurs

Bonjour, je voudrais copier un Range(A6 à A10) d'une feuille d'un classeur et aller la porter dans plusieurs classeurs qui sont dans des sous-répertoires.

Les répertoires ressemble à ceci:

documents\test\bureau

documents\test\bureau\secrétaire

documents\test\bureau\comptable

documents\test\usine

documents\test\usine\entrepôt

etc.

Voilà le code que j'ai trouvé et essayer d'adapter mais ça ne fonctionne pas. Ça bogue à : Set Fichiers = Dossier.Files probablement à cause de mon .subfolder que je ne sais pas s'il doit être définie par une variable. Je ne suis pas certain que le reste est bon non plus... mais ça fonctionne très bien si j'enlève le .subfolder.

Private Sub Ouvre_Fichiers()

' Ouvre tous les fichiers excel contenus dans un répertoire.

'

Dim Système As Object 'Système de fichiers

Dim Dossier As Object 'Répertoire

Dim Fichiers As Object 'Collection de fichiers du répertoire

Dim Fichier As Object 'Fichier (élément de la collection Fichiers)

Dim Nom_Dossier As String 'Nom du répertoire

Dim Nom_Fichier As String 'Nom du fichier

'Lecture du répertoire

Nom_Dossier = "C:\Users\Documents\test"

Set Système = CreateObject("Scripting.FileSystemObject")

Set Dossier = Système.GetFolder("C:\Users\Documents\test").SubFolders

Set Fichiers = Dossier.Files

'Contrôler chaque fichier du répertoire

For Each Fichier In Fichiers

'- Vérifier s'il s'agit d'un fichier Excel...

'If StrComp(Système.GetExtensionName(Fichier.Name), "xlsx", vbTextCompare) = 0 Then

'... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons

Nom_Fichier = Nom_Dossier & "\" & Fichier.Name

Workbooks.Open Filename:=Nom_Fichier, UpdateLinks:=xlUpdateLinksAlways

'End If

Next Fichier

End Sub

Merci de votre aide.

tu dois aussi boucler sur tes subfolders

Merci mais je n'y arrive pas. J'essaie plein de chose de puis ce matin mais rien n'y fait. Pouvez-vous me donner un exemple de code?

merci

Set FSO = CreateObject("Scripting.FileSystemObject")
for each f1 in FSO.getfolder("C:\Users\Documents\test\").SubFolders
for each f2  In f1.files

'ton code

next f2
next f1

Bonjour, merci pour la réponse. Voici ce que j'ai fait avec mais ça ne fonctionne pas.

Private Sub Ouvre_Fichiers3()

' Ouvre tous les fichiers excel contenus dans un répertoire.

'

Dim FSO As Object 'Système de fichiers

Dim Dossier As Object 'Répertoire

Dim Fichiers As Object 'Collection de fichiers du répertoire

Dim Fichier As Object 'Fichier (élément de la collection Fichiers)

Dim Nom_Dossier As String 'Nom du répertoire

Dim Nom_Fichier As String 'Nom du fichier

'Lecture du répertoire

Nom_Dossier = "C:\Users\jsgermain\Documents\test"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Dossier = Système.getfolder("C:\Users\Documents\test")

Set Fichiers = Dossier.Files

'Contrôler chaque fichier du répertoire

For Each f1 In FSO.getfolder("C:\Users\Documents\test\").SubFolders

For Each f2 In f1.Files

'- Vérifier s'il s'agit d'un fichier Excel...

If StrComp(Système.GetExtensionName(Fichier.Name), "xlsx", vbTextCompare) = 0 Then

'... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons

Nom_Fichier = Nom_Dossier & "\" & Fichier.Name

Workbooks.Open Filename:=Nom_Fichier, UpdateLinks:=xlUpdateLinksAlways

End If

'Next Fichier

Next f2

Next f1

End Sub

Evidemment tu fais n'importe quoi!

wow! quel réponse. Ça m'aide beaucoup cela. Si je connaissait la réponse, je ne demanderais pas... Je peux me passer de réponse comme ça.

Si quelqu'un d'autre a la gentillesse de m'aider j'apprécierais.

merci

Bolosse :

Private Sub Ouvre_Fichiers3()

Dim FSO As Object 'Système de fichiers
Set FSO = CreateObject("Scripting.FileSystemObject")

Dossier = "C:\Users\Documents\test\"

'Contrôler chaque fichier du répertoire
For Each f1 In FSO.getfolder(Dossier).SubFolders
For Each f2 In f1.Files
If StrComp(FSO.GetExtensionName(f2.Name), "xlsx", vbTextCompare) = 0 Then
Workbooks.Open f2.path
End If
'Next Fichier
Next f2
Next f1
End Sub

merci mais ça fait la même chose que j'avais mais c'est simplifié. Ça ouvre les fichiers qui sont dans le répertoire test mais pas ceux qui sont dans les sous-répertoires. J'ai une trentaine de fichier à ouvrir qui sont dans une dizaine de sous-répertoire. Est-ce que sa s'arrête qu'à un niveau la recherche de fichier et de répertoire?

merci

Ça ouvre tous les xlsx contenus dans les sousrepertoires de test... testé et approuvé

Bon je te remercie pour la réponse mais malheureusement, ça ne fonctionne pas chez moi. La lecture s'arrête qu'aux fichiers du premier répertoire et j'ai copié intégralement ta SUB. Il y a quelque chose qui ne fonctionne pas mais je ne sais pas quoi. J'ai lu beaucoup sur le sujet et je sais que ta formule est bonne mais ça ne marche pas. Merci de ton aide. Je continue à chercher.

En fait, il bloque sur cela: Workbooks.Open f2.Path

Il ouvre les 4 premier fichier mais s'arrête là et semble vouloir recommencer la boucle car il me dit qu'il ne peut ré-ouvrir le premier fichier car il est déjà ouvert. C'est comme s'il ne changeait pas de répertoire.

Le problème est dans certain fichier. Je ne sais pas ce qui bloque la requête mais certain fichier ne s'ouvre pas à partir de la requête mais s'ouvre très bien dans excel. Je te remercie de ton aide. Ça m'a été très utile.