Selectionner une feuille en fonction de son code name défini par une variable
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:
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.
