Discussion :

[Valentine_Chips]

Bonjour,

Je suis en train d'écrire un programme qui a pour objectif d'aller chercher des informations (toujours au même endroit) dans les fichiers Excel d'un répertoire pour les réunir dans un autre fichier excel qui fait office de tableau de bord. Je souhaite que les fichiers restent fermés pendant l'exécution. Voici mon programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub importdonees()
 
Dim principal As ThisWorkbook
Dim repertoire As String
Dim fichier As String
Dim i As Integer
 
 
repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\*.xlsm"
 
fichier = Dir("P:\Valentine\Système alerte qualité\Alertes qualités\*.xlsm")
 
i = 2
 
    While Len(fichier) > 0
 
           MsgBox fichier
        i = i + 1
 
        Range("B" & i).Select
 
    ActiveCell.FormulaR1C1 = _
        "='P:\Valentine\Système alerte qualité\Alertes qualités\[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R4C3"
Range("C" & i).Select
 
 
    ActiveCell.FormulaR1C1 = _
        "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R4C5"
    Range("D" & i).Select
 
    ActiveCell.FormulaR1C1 = _
        "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R6C3"
    Range("E" & i).Select
 
    ActiveCell.FormulaR1C1 = _
        "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R3C13"
    Range("F" & i).Select
 
    ActiveCell.FormulaR1C1 = _
        "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R9C10"
 
 
        fichier = Dir
 
 
    Wend
 
End Sub

Pour l'instant je n'ai que 4 fichiers dans mon répertoire mais à l'avenir il pourrait y en avoir des centaines, d'où la nécessité de faire une boucle.J'ai testé, la boucle marche. Néanmoins, pour l'instant mon programme ne transfère que les valeurs d'un même fichier "AlerteQF_20_08_19.xlsm" puisque je ne l'ai pas changé.

Je cherche donc un moyen de mettre une variable dans mon chemin d'accès, comme la variable "fichier" dans mon cas qui serait parfaite pour remplacer [AlerteQF_20_08_19.xlsm]. Est-ce que cela est possible?

Merci d'avance

[patricktoulon]

pas testé mais si on parle de concatenation du string de ta formule ca doit etre ca
et surtout sans select
le parent du range n'est pas précisé tu devrait le faire !!!!!!!!!!!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub importdonees()
 Dim principal As ThisWorkbook
 Dim repertoire As String
 Dim fichier As String
 Dim i As Integer
 
 repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\"
 fichier = Dir(repertoire & "*.xlsm")
 i = 2
 While Len(fichier) > 0
 MsgBox fichier
 i = i + 1
 
 Range("B" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R4C3"
 
 Range("C" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R4C5"
 
  Range("D" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R6C3"
 
 Range("E" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R3C13"
 
 Range("F" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R9C10"
 
 fichier = Dir
 
 Wend
End sub

Attention !! j'ai oublié de précisé que dans ce répertoire il ne doit y avoir que des fichiers concernés avec un sheets("Alerte_qualité_fournisseur")
sinon il faudra mettre un test avec evaluate par exemple

[Valentine_Chips]

Ca marche, merci beaucoup !!!!

J'ai indiqué les parents, c'est parfait maintenant

[patricktoulon]

de rien
on peut simplifier le code si tu veux
ca doit être cela si je ne me trompe pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub importdonees()
 Dim principal As ThisWorkbook
 Dim repertoire As String
 Dim fichier As String
 Dim i As Integer
 Dim formula as string
 repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\"
 fichier = Dir(repertoire & "*.xlsm")
 i = 2
 While Len(fichier) > 0
 MsgBox fichier
 i = i + 1
Formula = "=''" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur''!"
 
 Range("B" & i).FormulaR1C1 = Formula & "R4C3"
 
 Range("C" & i).FormulaR1C1 = Formula & "R4C5"
 
  Range("D" & i).FormulaR1C1 = Formula & "R6C3"
 
 Range("E" & i).FormulaR1C1 = Formula & "R3C13"
 
 Range("F" & i).FormulaR1C1 = Formula & "R9C10"
 
 fichier = Dir
 
 Wend
 End Sub

[Valentine_Chips]

Merci j'ai tenté de mettre votre simplification en place mais elle bug à la ligne : Range("B" & i).FormulaR1C1 = formula & "R4C3".

La première version marche très bien en tout cas!

[patricktoulon]

re
Bonjour
oui je me suis un peu pressé
il ne faut pas doubler les simples quotes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Formula = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!"

j'ai testé ca fonctionne


voila j'ai ajouté le test de validité de la formule
je n'y suis pas arrivé avec evaluate je l'ai fait avec ExecuteExcel4Macro
les erreurs ne devraient pas être bloquantes et si il y en a ; un message te dis sur quel fichier(s) il y a eu une/des erreur(s)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub importdonees()
    Dim principal As ThisWorkbook, repertoire$, fichier$, i%, formula$, mess$
    repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\"
    fichier = Dir(repertoire & "*.xlsm")
    feuille = "Alerte_qualité_fournisseur"
      i = 2
    While Len(fichier) > 0
         i = i + 1
        If Not IsError(ExecuteExcel4Macro("'" & repertoire & "[" & fichier & "]" & feuille & "'!" & "R4C3")) Then
 
            formula = "='" & repertoire & "[" & fichier & "]" & feuille & "'!"
            Range("B" & i).FormulaR1C1 = formula & "R4C3"
            Range("C" & i).FormulaR1C1 = formula & "R4C5"
            Range("D" & i).FormulaR1C1 = formula & "R6C3"
            Range("E" & i).FormulaR1C1 = formula & "R3C13"
            Range("F" & i).FormulaR1C1 = formula & "R9C10"
            fichier = Dir
        Else
            mess = mess & repertoire & fichier & vbCrLf
        End If
    Wend
If mess <> "" Then mess = "donnée(s) non récupérée(s) dans " & vbCrLf & mess
 
End Sub

[Valentine_Chips]

Top ! Merci beaucoup