Bonjour à tous,

Voici mon problème: J'ai un classeur comportant 35 onglets qui représentent les résultats commerciaux de chaque service de ma société.
Pour chaque service, il y a deux feuilles correspondantes: une feuille avec le détail et une feuille synthèse qui est lié à la feuille détail qui totalise les résultats.
Je dois créer un fichier pour chaque service avec les deux feuilles concernées.

J'ai crée une Macro Vba qui fait les actions suivantes:
--> Changer les codes name de chaque feuille pour ne pas être embêter si les noms des onglets changent.
--> Boucler sur chaque feuille du classeur et appliquer un code selon le code name

J'ai besoin de votre aide car je n'arrive pas à trouver le code correct pour déterminer en fonction de la feuille avec le détail la feuille de synthèse correspondante et les coller tous les deux dans un nouveau classeur.

Voici mon code. Dans cet exemple, je dois copier la feuille Fe06 et Fe07 dans un nouveau classeur

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
 
'Définir les paramètres
 
 
Public ANNEE As String
Public PERIODE As String
Public FICHIER_ORIGINE As String
Public CHEMIN_ORIGINE As Variant
Public CHEMIN As String
Public DOSSIER As String
Public SS_DOSSIER As String
Public SERVICE As String
Public CHEMIN_FICHIER_DECOUPAGE As Variant
Public She As Worksheet
Public NomFichier As String
Public NomFeuille As String
 
 
Sub Decoupage_Fichier()
 
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim Sh4 As Worksheet
Dim Sh5 As Worksheet
Dim Sh6 As Worksheet
Dim Sh7 As Worksheet
Dim ShS As Worksheet
Dim Fe07 As Worksheet
Dim NomShs As String
 
'Définir les valeurs des paramètres
    ANNEE = Range("C4").Value
    PERIODE = Range("C5").Value
    FICHIER_ORIGINE = Range("C6").Value & ".xlsx"
    CHEMIN_ORIGINE = Workbooks(FICHIER_ORIGINE).FullName
 
'Créer les sous dossier le cas échéant :
    CHEMIN = "W:\TDB BUDGET BILAN FRANCE\ETB\"
    DOSSIER = "\Budget\CA"
    SS_DOSSIER = "\Envois\"
 
        'Pour le dossier ANNEE
            If Dir(CHEMIN & ANNEE, 16) = "" Then
            MkDir (CHEMIN & ANNEE)
            End If
        'Pour le dossier Travaux TDB (DOSSIER)
            If Dir(CHEMIN & ANNEE & DOSSIER, 16) = "" Then
            MkDir (CHEMIN & ANNEE & DOSSIER)
            End If
        'Pour le dossier Envois Données (SS_DOSSIER)
            If Dir(CHEMIN & ANNEE & DOSSIER & SS_DOSSIER, 16) = "" Then
            MkDir (CHEMIN & ANNEE & DOSSIER & SS_DOSSIER)
            End If
        'Pour le dossier PERIODE
            If Dir(CHEMIN & ANNEE & DOSSIER & SS_DOSSIER & PERIODE, 16) = "" Then
            MkDir (CHEMIN & ANNEE & DOSSIER & SS_DOSSIER & PERIODE)
            End If
 
'Activer le fichier d'origine à découper
Windows(FICHIER_ORIGINE).Activate
 
'Mettre en calcul Manuel
        'Application.Calculation = xlManual
 
'Qualifier les feuilles et changer le Code Name
        'ETB
            Set Sh1 = Sheets("ETB")
            Sh1.[_CodeName] = "Fe01"
        'ETB Exploitation
            Set Sh2 = Sheets("ETB Exploitation")
            Sh2.[_CodeName] = "Fe02"
        'ETB Zones-Ciaux
            Set Sh3 = Sheets("ETB Zones-Ciaux")
            Sh3.[_CodeName] = "Fe03"
        'ETB Ciaux-Zones
            Set Sh4 = Sheets("ETB Ciaux-Zones")
            Sh4.[_CodeName] = "Fe04"
        'ETB Budget Mensuel
            Set Sh5 = Sheets("ETB Budget Mensuel")
            Sh5.[_CodeName] = "Fe05"
        'Synthèse DOM TOM
            Set Sh7 = Sheets("Synth DOM TOM")
            Sh7.[_CodeName] = "Fe07"
        'DOM TOM
            Set Sh6 = Sheets("DOM TOM")
            Sh6.[_CodeName] = "Fe06"        
 
 
 For Each She In ActiveWorkbook.Worksheets
 
 Select Case She.[_CodeName]
 
'Fichier "DOM TOM"
 
        Case Is = "Fe06"
                'Définir le nom du Service en fonction de la ou les feuilles copiées
                    SERVICE = "DOM TOM"
                    T = 6
                'Définir la feuille synthèse
                If T + 1 < 10 Then
                    NomShs = "Fe0" & T + 1
                              Else
                    NomShs = "Fe" & T + 1
                End If
 
'Voici l'endroit où je ne trouve pas le bon code             
                    'Sheets(NomShs).Select
                    'Set Fe = NomShs
                    Sheets(Fe07).Select
 
 
                'Copier les feuilles dans un nouveau classeur --> besoin d'aide pour ce code aussi
 
 
                'Définir le chemin du fichier découpage
                    CHEMIN_FICHIER_DECOUPAGE = CHEMIN & ANNEE & DOSSIER & SS_DOSSIER & PERIODE & "\Matrice Budget ETB_" & SERVICE & "_" & PERIODE & ".xlsx"
 
                    Call ENREGISTRER_CLASSEUR
                    Sheets.Add Count:=1
 
                'Fermer le fichier et activer le fichier d'origine
                    Call FERMER_CLASSEUR
                    Workbooks(FICHIER_ORIGINE).Activate
 
 
        Case Is = "Fe08"
...
 End Select
 Next She
 
 MsgBox ("les Fichiers sont prêts pour l'envoi")
 
 End Sub
Je vous remercie par avance de votre aide.