Redirection macro sur onglet

Version imprimable

Bonjour,

J'ai crée une macro dont l'objectif est d'afficher les données de certain onglet présents dans des fichiers eux mêmes présents dans un dossier.
L'objectif de tout ça est que sur un fichier principale Excel ou est présent un Template. La macro crée un onglet pour chacun des fichiers présents dans mon dossier et copie le Template de l'onglet "Template" sur chaque nouvel onglet crée.

Tout fonctionne jusque là et j'arrive à récupérer les données que je souhaite en faisant un système de lien.
Maintenant là ou j'avais un problème que j'ai réussi partiellement à résoudre c'est dans le cas d'une actualisation des données, ou, si on rajoute d'autre fichier dans le dossier cité ci-dessus la macro n'arrive pas à faire son travail correctement si je la relance.

Elle va mettre le Template de l'onglet "Template" sur le nouvel onglet crée correspondant au fichier, (celui-ci sera nommé X pour plus de compréhension), mais va afficher les valeurs récupérées du fichier correspondant dans le mauvaise onglet (à chaque fois dans le premier onglet exemple A).

J'espère avoir été compréhensible sur l'origine de mon problème, voici mon code :
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 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 Sub qsd() Dim nomFeuille As String, monFichier As String, chemin As String Dim num_onglet As Integer Set wb = Workbooks(ThisWorkbook.Name) chemin = ThisWorkbook.Path & "\test2\" monFichier = Dir(chemin & "*.xlsx", vbNormal) Do While monFichier <> "" 'Ici je cr?e un onglet pour chaque nom de fichier dans mon dossier nomFeuille = Split(Split(monFichier, "-")(2), "_")(0) For Each sh In ThisWorkbook.Sheets If sh.Name = nomFeuille Then 'Sheets("Template").Range("A1:AH127").Copy Destination:=sh.Range("A1") GoTo SUIVANT End If Next 'Si on arrive ici, c'est que la feuille nomFeuille n'existe pas encore Sheets.Add After:=Sheets(Sheets.Count) 'Devient la feuille active ActiveSheet.Name = nomFeuille Sheets("Template").Range("A1:AH127").Copy Destination:=Sheets(nomFeuille).Range("A1") num_onglet = num_onglet + 1 Sheets(8 + num_onglet).Activate Sheets(8 + num_onglet).Range("A1").FormulaR1C1 = nomFeuille 'MsgBox "vérif" 'Recuperation des donn?es des FIT_MECH For i = 8 To 154 Select Case nomFeuille Case "T1" 'Temps 'Ici je crée un lien pour aller récupérer les valeurs dans l'onglet Test1 de mon fichier, de mon dossier. j = 3 Cells(i - 4, j - 2) = "='" & chemin & "[" & monFichier & "]Test1'!R" & i & "C" & j: Case Else: 'Tout ce qui n'est pas l'onglet T1 'Temps j = 3 Cells(i - 4, j - 2) = "='" & chemin & "[" & monFichier & "]Test'!R" & i & "C" & j: End Select Next 'Permet de passer au fichier suivant en vidant le nomFicheir SUIVANT: monFichier = Dir Loop End Sub
Merci pour votre aide.

Citation:

Envoyé par Entei

Bonjour,

A tester :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
 
Sub Qsd()
 
Dim NomFeuille As String, MonFichier As String, Chemin As String
Dim Sh As Worksheet, NouvelOnglet As Worksheet
Dim OngletTrouve As Boolean
 
 
    Chemin = ActiveWorkbook.Path & "\test2\"
    MonFichier = Dir(Chemin & "*.xlsx", vbNormal)
 
    Do While MonFichier <> ""
 
         Debug.Print MonFichier
       'Ici je crée un onglet pour chaque nom de fichier dans mon dossier
        NomFeuille = Split(Split(MonFichier, "-")(2), "_")(0)
 
        OngletTrouve = False
        For Each Sh In Sheets
            If Sh.Name = NomFeuille Then
               OngletTrouve = True
               Exit For
            End If
        Next
 
        If OngletTrouve = False Then
 
           Set NouvelOnglet = Sheets.Add(After:=Sheets(Sheets.Count)) 'Devient la feuille active
           Sheets("Template").Range("A1:AH127").Copy Destination:=NouvelOnglet.Range("A1")
           MettreEnFormeLeNouvelOnglet NouvelOnglet, NomFeuille, MonFichier, Chemin
           Set NouvelOnglet = Nothing
 
        End If
        MonFichier = Dir
 
    Loop
 
 
 
End Sub
 
Sub MettreEnFormeLeNouvelOnglet(ByVal NouvelOnglet2 As Worksheet, ByVal NomFeuille2 As String, ByVal Monfichier2 As String, ByVal Chemin2 As String)
 
Dim I As Integer, J As Integer
 
    With NouvelOnglet2
 
         .Name = NomFeuille2
         .Range("A1") = NomFeuille2
         J = 3
 
         'Récuperation des données des FIT_MECH
         '-------------------------------------
         For I = 8 To 154
             Select Case NomFeuille2
 
                    Case "T1"
                         'Temps 'Ici je crée un lien pour aller récupérer les valeurs dans l'onglet Test1 de mon fichier,
                         ' de mon dossier.
                         .Cells(I - 4, J - 2).FormulaR1C1 = "='" & Chemin2 & "[" & Monfichier2 & "]Test1'!R" & I & "C" & J
 
                    Case Else: 'Tout ce qui n'est pas l'onglet T1
                         'Temps
                         .Cells(I - 4, J - 2).FormulaR1C1 = "='" & Chemin2 & "[" & Monfichier2 & "]Test'!R" & I & "C" & J
 
              End Select
         Next I
 
   End With
 
End Sub

27/08/2020, 16h10
Entei

C'est parfait ! Merci beaucoup
28/08/2020, 11h32
Entei

Bonjour,

Je me permets de faire une seconde requête.

Le code fonctionne parfaitement si on souhaite ajouter un seul fichier en plus.

J'ai essayé de créer une boucle pour effectuer la même chose mais pas uniquement pour un seul fichier, mais pour autant qu'il y en a de plus que pour le premier lancement.

Pourriez vous m'indiquer une piste à suivre s'il vous plait ?

Merci d'avance.
28/08/2020, 11h41
Invité

Citation:

Envoyé par Entei

Bonjour,

Logiquement le code récupère tous les fichiers qui ne seraient pas encore connus dans le fichier, je ne vois donc pas le problème. Il faudrait donner plus d'explications.
28/08/2020, 11h46
Entei

Bonjour,

Veuillez m'excuser j'ai vérifié de mon coté et j'avais modifié une ligne qui faisait justement fichier par fichier.

Votre code fonctionne parfaitement.

Merci encore !