[XL-2007] boucle auto sur fichier externe

[Giantrick]

Bonjour,

J'ai une macro qui synchronise plusieurs fichiers excel externe à mon fichier possédant la macro.

Fichier principal : Tableau de bord (TDB_GENERAL.xlsm)
Fichiers à synchroniser : "n" fichier dans un même répertoire (tab_nego_XXX.xlsm).

Aujourd'hui, j'ai écrit autant de fois la boucle de mon script VBA en modifiant manuellement le nom de mes fichiers excel à synchroniser.

Mon souci, c'est que si on ajoute un ou plusieurs fichier à synchroniser il faut modifier manuellement le VBA.

Je sais qu'il y a une boucle à faire pour que mon script soit appelé qu'une seule fois.

La construction du nom des fichiers est identique et normé comme suit :

tab_nego_XXX.xlsm

Le XXX correspond au initiale du négociant. Ces initiales sont dans la liste récap d'une feuille du tableau principal (TDB_GENERAL.xlsm).

Comment faire pour :

- récupérer les initiales de cette liste
- compiler le nom de chaque fichier (tab_nego_) plus les initiales (.xlsm)
- et faire la boucle sur chaque fichier du répertoire jusqu'à la fin de la liste des initiales.

Voici mon code VBA actuel :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Windows("TDB_NEGO_EM.xlsm").Activate
    Sheets("ZZZZZZZ").Select
    Columns("A:M").Select
    Selection.Copy
    Windows("XXXXXXX.xlsm").Activate
    Sheets("YYYYYYY").Select
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
 
... / ...
    Windows("TDB_NEGO_EM.xlsm").Activate
    Sheets("ZZZZZZZ").Select
    Rows("1:102").Select
    Selection.Copy
.../...
 
    Sheets("YYYYYYY").Select
    Columns("A:M").Select
    Selection.ClearContents

Le code ci-dessus est coupé mais il fonctionne très bien aujourd'hui, c'est juste une boucle sur les noms des fichiers qu'il me faut... sachant que le nom du fichier est utilisé au tout début du code et au milieu du code VBA.

J'espère avoir été suffisamment explicite.

Merci d'avance de vos réponses.

[jfontaine]

Bonjour,


Le code ci dessous ouvre chaque fichier xlsm du répertoire "C:\" et copie la plage A1 à C1 de la feuille ZZZZZZ dans la feuille YYYYYY du fichier en contenant la macro

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Dim fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object
Dim i As Long
Dim Wrk As Workbook
 
Dim str() As String
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = fso.GetFolder("C:\")
 
 
'Boucle sur fichiers du repertoire
i = 1
For Each FsoFichier In FsoRepertoire.Files
    str = Split(FsoFichier.Name, ".")
    If str(UBound(str)) = "xlsm" Then
'        Range("A" & i).Value = FsoFichier.Path
        Set Wrk = Application.Workbooks.Open(FsoFichier.Path)
 
        Wrk.Sheet("ZZZZZZZ").Range("A1:C1").copy
        ThisWorkbook.Sheets("YYYYYY").Range("A" & ThisWorkbook.Sheets("YYYYYY").Range("A65536").End(xlUp).Row + 1).Paste
 
        Wrk.Close
 
        i = i + 1
    End If
Next

Je te laisse le soin d'adapter à ton besoin et de revenir vers le forum si tu bloques