Bonjour,

Voila maintenant depuis quelques jours que je bute sur un problème.

Tout d'abord, donc j'ai une application créer en VBA excel. Le problème est que lors de la génération de mes onglets la récupération de mes valeurs ne s'affiche pas. Imposssible de traiter la colonne dans "delais obj" et "dans délai limite", de plus il m'es impossible d'arriver a générer les valeurs pour un autre onglet. Je ne sais pas si vous avez compris pour cela en message privé je peux vous transmettre le fichier. Voici un screen et le code associés pour mon premier problème:
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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
 
Sub appelContributeurs()
 
 
If OngletRequeteAltisTE = False Then
    Exit Sub
End If
 
 
Call enleverMasquer
Call recup_donnes
 
onglet = "liste_total"
'Workbooks("TdB_Reactivite_DCTC_V5.xlsm")
With Worksheets(onglet)
    If .FilterMode = True Then .ShowAllData
    If .AutoFilterMode = False Then ' s'il n' y a pas de filtre
        .Range(.Cells(1, 1), .Cells(1, macolonne)).AutoFilter
    End If
End With
 
' trie par Q altis
l = Range("A1").End(xlDown).Row
ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Clear
   ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Add Key:= _
   Worksheets(onglet).Range("D2:D" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
 
 
ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Add Key:= _
Range("AB1:AB" & l), SortOn:=xlSortOnValues, Order:=xlDescending, CustomOrder _
        := _
        "Prio 40 J,Prio 120 J,En Fenêtre" _
        , DataOption:=xlSortNormal
 
    ' car le calcul des impact ce fait pour chaque fait technique sur la derniere ligne or on veut garder le delai le plus gros : on classe par ordre croissant
   ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Add Key:= _
        Range("AH2:AH" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
 
    With ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'MsgBox "tri effectué :) ! "
 
    'calcul le nb d'impact et les differents delais
    Call ajouteImpactCont(onglet)
 
    Application.DisplayAlerts = False
    Call FormaterDonnesContributeurs ' formate les données des deux onglets(32 metiercontributeurs), les assemble dans le meme onglet pour pouvoir les comparer avec la liste total
    'MsgBox "format ok"
 
 
    'MsgBox "attention on compare ! "
    Call compar 'permet de faire le liens entre les donnée de la liste total et les donnée de metier contributeurs
 
    'MsgBox "attention on genere lentete"
   Call libelle
 
    'MsgBox "attention on suppr inutile"
    Worksheets("MetierContributeurs").Activate
    Call suppreColInutileMetContr
 
 
    'apeler genere les contributeurs
   Call Generer_onglets_contributeur_Rempli
 
   Call Generer_onglet_contributeurs_Anomalie
 
 
    'a remettre mais pour l'instant plus pratique de les avoir pour test
    Sheets("32.Métiers Contributeurs").Delete
    If FeuilleInexistante("32.Métiers Contributeurs (2)") = False Then
        Sheets("32.Métiers Contributeurs (2)").Delete
    End If
 
    If FeuilleInexistante("32.Métiers Contributeurs (3)") = False Then
        Sheets("32.Métiers Contributeurs (3)").Delete
    End If
 
    If FeuilleInexistante("32.Métiers Contributeurs (4)") = False Then
        Sheets("32.Métiers Contributeurs (4)").Delete
    End If
    'on remet en forme la liste total initial
    Call recup_donnes
 
    Call Tri_Liste_Prio_delais ' aremettre
 
 
    Call MEFcontributeurs ' a remettre
 
End Sub
 
 
Sub Tri_Liste_Statut_Prio_delais_Contributeurs(onglet)
With Worksheets(onglet)
 l = .Range("A1").End(xlDown).Row
' MsgBox "l: " & l
 
'trie par statut ,  priorite et delai k : priorite et n : délai réactivité ou encours '
 .AutoFilter.Sort.SortFields.Clear
   ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Add Key:= _
        Range("L1:L" & l), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
        := _
        "traité,Encours" _
        , DataOption:=xlSortNormal
 
    ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Add Key:= _
        Range("K1:K" & l), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
        := _
        "Prio 40 J,Prio 120 J,En Fenêtre" _
        , DataOption:=xlSortNormal
 
    ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort.SortFields.Add Key:= _
        Range("M2:M" & l), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
 
    With ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 
End With
End Sub
 
 
Sub ajouteImpactCont(onglet)
'pe
'calcul les impacts pour chaque reference
 Worksheets(onglet).Activate
 
 'probleme car premier ligne impact pas =0 mais a 1 mais lequel ?
 With Worksheets(onglet)
 
 macolonne = .Range("A1").End(xlToRight).Column 'nb de colonne
 
For num = 1 To macolonne
    If Cells(1, num).Value = "Respect délai objectif" Then ' "dans hors"
        colDelai = num
       ' MsgBox "la colonne : Respect délai objectif" & " a pour num de col : " & num
    End If
    If Cells(1, num).Value = "Respect délai limite" Then '"delai limite"
        ColDelaiLimite = num
        'MsgBox "la colonne : Respect délai limite" & " a pour num de col : " & num
    End If
    If Cells(1, num).Value = "Référence FT" Then
        ColRef = num
    End If
Next num
 
'premier ligne : col delai objectif
 
impact_total = 1
 
    If .Cells(2, colDelai).Value = "dans delai" Then
        impact_del_obj = 1
     Else
        impact_del_obj = 0
    End If
 
 
    If .Cells(2, ColDelaiLimite).Value = "dans delai" Then
    impact_del_lim = 1
    Else
    impact_del_lim = 0
    End If
 
     'ajoute les col impact
   ' Columns("BV:BV").Select
   Columns("AX:AX").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "AX") = "impact Total "
    '.Cells(1, "BV") = "impact Total "
 
    'Columns("BW:BW").Select
    Columns("AY:AY").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "AY") = "dans délai obj"
   ' .Cells(1, "BW") = "impact delai obj "
 
    'Columns("BX:BX").Select
    Columns("AZ:AZ").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "AZ") = "dans délai limite"
    '.Cells(1, "BX") = "impact delai limite "
 
    som = .Cells(Rows.Count, "A").End(xlUp).Row
   'calcul l'impact et le met sur la col impact et dans la ligne correspondante
    For numLigne = 2 To som
       If .Cells(numLigne, ColRef).Value = .Cells(numLigne + 1, ColRef).Value Then ' si meme question alor on compte les impacts
            'MsgBox NumLigne & " , " & .Cells(NumLigne, 1).Value
 
            If .Cells(numLigne, colDelai).Value = .Cells(numLigne + 1, colDelai).Value Then
 
                If .Cells(numLigne, colDelai).Value = "dans delai" Then
                impact_del_obj = impact_del_obj + 1 '
                End If
 
            Else
 
                If .Cells(numLigne + 1, colDelai).Value = "dans delai" Then
                impact_del_obj = impact_del_obj + 1 '
                End If
            End If '
 
            impact_total = impact_total + 1
 
        Else 'plus la meme reference dc on met le resultat dans les col et on initialise les impacts
           ' MsgBox "ref" & .Cells(numLigne, ColRef).Value & " à pour nombre d'impact : " & impact_total
            'mettre dans la col
            '.Cells(numLigne, "BV") = impact_total
            '.Cells(numLigne, "BW") = impact_del_obj
            .Cells(numLigne, "AX") = impact_total
            .Cells(numLigne, "AY") = impact_del_obj
 
 
            'on compte l'impact de la prochaine ligne
            impact_total = 1
 
            If .Cells(numLigne + 1, colDelai).Value = "dans delai" Then
                impact_del_obj = 1 '
            Else
                impact_del_obj = 0
            End If
 
 
        End If
 
 
 
        'calcul delai limite
 
        If .Cells(numLigne, ColRef).Value = .Cells(numLigne + 1, ColRef).Value Then ' si meme question alor on compte les impacts
            'MsgBox NumLigne & " , " & .Cells(NumLigne, 1).Value
 
            If .Cells(numLigne, ColDelaiLimite).Value = .Cells(numLigne + 1, ColDelaiLimite).Value Then ' a tester
                If .Cells(numLigne, ColDelaiLimite).Value = "dans delai" Then
                    impact_del_lim = impact_del_lim + 1  '
                End If
 
            Else 'a tester
 
                If .Cells(numLigne + 1, ColDelaiLimite).Value = "dans delai" Then
                    impact_del_lim = impact_del_lim + 1   '
                End If
            End If '
 
 
        Else 'plus la meme reference dc onmet le resultat dans les col et on initialise les impacts
           ' MsgBox "ref" & .Cells(numLigne, ColRef).Value & " à pour nombre d'impact limite : " & impact_del_lim
            'mettre dans la col
            '.Cells(numLigne, "BX") = impact_del_lim
            .Cells(numLigne, "AZ") = impact_del_lim
 
            If .Cells(numLigne + 1, ColDelaiLimite).Value = "dans delai" Then
                impact_del_lim = 1 '
            Else
                impact_del_lim = 0
            End If
 
 
        End If
 
 
 
 
    Next numLigne
 
End With
 
 
End Sub
 
 
 
 
 
 
Sub CopiMetiersSansCoul(ongletorigine, ongletmetiers)
'
'
'
 
'
'Application.DisplayAlerts = False
 
    Worksheets(ongletorigine).Activate
    Cells.Select
    Selection.Copy
    Worksheets(ongletmetiers).Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:2").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub
 
 
Sub FormaterDonnesContributeurs()
'
'
'
'TODO : copie dans metier (que les val pas leur format + delete les 2 premiere ligne)
 
Dim onglet
ongletTemp = "metiers"
    On Error Resume Next
    Sheets("MetierContributeurs").Delete
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "MetierContributeurs"
 
    'fichier temporaire
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = ongletTemp
 
    Call CopiMetiersSansCoul("32.Métiers Contributeurs", ongletTemp)
 
    If FeuilleInexistante("32.Métiers Contributeurs (2)") = False Then
    Call Copiiacticdv("32.Métiers Contributeurs (2)", ongletTemp)
    End If
    If FeuilleInexistante("32.Métiers Contributeurs (3") = False Then
    Call Copiiacticdv("32.Métiers Contributeurs (3)", ongletTemp)
    End If
    If FeuilleInexistante("32.Métiers Contributeurs (4") = False Then
    Call Copiiacticdv("32.Métiers Contributeurs (4)", ongletTemp)
    End If
 
With Worksheets(ongletTemp)
 
    macolonne = .Range("A1").End(xlToRight).Column 'nb de colonne
 
    If .FilterMode = True Then .ShowAllData
    If .AutoFilterMode = False Then ' s'il n' y a pas de filtre
        .Range(.Cells(1, 1), .Cells(1, macolonne)).AutoFilter
    End If
 
    'identifiant solution : vide
    .Cells(1, 1).AutoFilter Field:=2, Criteria1:="="
 
    'MsgBox "on copi tt ds metierscontributeurs"
    'copi le contenu (filtré et sans couleur format ...) de metiers dans metier contributeurs
    .Cells.Copy
    Worksheets("MetierContributeurs").Activate
    Range("A1").Select
    ActiveSheet.Paste
 
    'plus besoin
   Sheets(ongletTemp).Delete
 
End With
End Sub
Sub test()
If FeuilleInexistante("32.Métiers Contributeurs (2 (3") = False Then
    MsgBox "esxiste 23"
    Else
    MsgBox "existe pas"
    'Call Copiiacticdv("32.Métiers Contributeurs (2 (3", ongletTemp)
End If
End Sub
 
Sub Copiiacticdv(ongletinitial, ongletmetiers)
 
    Sheets(ongletinitial).Select
    som = Worksheets(ongletinitial).Cells(Rows.Count, "B").End(xlUp).Row
    'MsgBox "derniere ligne onglet 32 : " & som
    Range("B1:D" & som).Select
    'MsgBox som
    Selection.Copy
 
    Sheets(ongletmetiers).Select
    dernLig = Worksheets(ongletmetiers).Cells(Rows.Count, "A").End(xlUp).Row
    'MsgBox "on ajoute le contenu de 32 à la derniere ligne : " & dernLig
    Range("A" & dernLig + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
     Rows(dernLig + 1 & ":" & dernLig + 2).Select
   ' Rows("415:416").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
 
End Sub
 
Sub compar()
'compare les reference de longlet MetierContributeurs et liste_total , si cest les meme : on met les valeur de la liste total dans les metiers contributeurs
'ce qui permet d'avoir une liste avec des données tels que la reference et la designation de ces metiers contributeurs avec dautres données tels que le libéllé l'accord d'analyse la priorité le delais ect
With Worksheets("MetierContributeurs")
 
    Set cell_testA = .Range("A1")
    Set cell_testB = Worksheets("liste_total").Range("D1")
    For i = 0 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1
        For j = 0 To Worksheets("liste_total").Columns(4).Find("*", , , , xlByColumns, xlPrevious).Row - 1
            If cell_testA.Offset(i, 0) = cell_testB.Offset(j, 0) Then
                For k = 1 To 48
                    cell_testA.Offset(i, k + 2) = cell_testB.Offset(j, k)
                Next k
            End If
        Next j
 
   Next i
End With
End Sub
 
 
 
Sub suppreColInutileMetContr()
onglet = "MetierContributeurs"
Dim valeurSup
'Dim MonDico As Dictionary
Set MonDico = CreateObject("Scripting.Dictionary")
'todo : Instance décisionel pr l'instant on enleve pas pr test et attention au tri si on enleve encor des col
valeurSup = Array("Type FT", "Origine_FT2", "Origine FT", "Accord Analyse", "Animateur Decisionnel FT", "Date de création FT", "Gravité effet client FT", "Domaine technique qualité FT", "Cadre Détection indicateur FT", "Recidives Même Cause après plan action FT", "Responsabilité fournisseur? FT", "Retex FT", "IVOFT", "Code produit FT", "Site fabrication FT", "Zone Geographique FT", "Impact pilote", "Phase FT", "Effet client", "Date création IVO FT", "Date IVO Effetclient", "Date IVO Priorite", "T0 Impact", "Nb jour restant", "date solution réactivité prévisionnelle", "date solution réactivité réelle", "Mois d 'application solution réactivité", "Date Previsionelle application Solution Provisoire", "Date Previsionelle application Solution Définitive", "Date réelle application Solution Provisoire", _
"Date réelle application Solution Définitive", "Date Previsionelle application Solution APV", "Date réelle application Solution APV", "Date réelle application mesure conservatoire", "Respect délai objectif", "Respect délai limite", _
"Tranche de délai", "Besoin diffusion APV", "Direction MOA", "Date objective maxi (respect délai)", "Regroupement MOA", "Zone géographique Animation", "centre", "regroupement Centre", "Zone géographique Centre", "Famille produit", "Amadeus", "fournisseur", "Préanlayste", _
"Date décision Abandon FT", "Instance décision Abandon FT", "Instance décision Analyse FT", "Instance décision Abandon Sol", "Date décision Abandon Sol", "Date max mesures conservatoires", "Date max Solution Palliative partielle", "Date max Solution Palliative complète", "Date max Solution définitive", "Date max Solution APV", "Impact pilote")
 
'--------------------------------------------------------------
'rempli le dictionnary des colonnes qu'on souhait supprimer
For l = LBound(valeurSup) To UBound(valeurSup)
    MonDico.Item(valeurSup(l)) = MonDico.Item(valeurSup(l))
Next l
 
With Worksheets(onglet)
'Supprime les colonnes inutiles
 macolonne = .Range("A1").End(xlToRight).Column ' les entetes de chaque colonnes dans une variable
     For i = macolonne To 1 Step -1 ' parcours les entetes
        If MonDico.Exists(.Cells(1, i).Value) Then ' supprimes les colonnes presentes dans le dictionnary
         Columns(i).Delete ' supp
        End If
     Next i
'et active les filtres
 macolonne = .Range("A1").End(xlToRight).Column
If .AutoFilterMode = False Then ' s'il n' y a pas de filtre : Active filtre
    .Range(.Cells(1, 1), .Cells(1, macolonne)).AutoFilter
End If
 
End With
 
End Sub
 
 
 
Sub libelle()
 
Dim Tablo
'Worksheets("Feuil3").Activate
Tablo = Worksheets("liste_total").Range("E1:AZ1").Value
Worksheets("MetierContributeurs").Range("D1:AY1").Value = Tablo
 
    With Worksheets("MetierContributeurs")
    macolonne = .Range("A1").End(xlToRight).Column 'nb de colonne
    If .FilterMode = True Then .ShowAllData 'si les données sont deja filtre on enleve pour pouvoir effectuer des operations
    If .AutoFilterMode = False Then ' s'il n' y a pas de filtre : Active filtre
        .Range(.Cells(1, 1), .Cells(1, macolonne)).AutoFilter
    End If
 
End With
 
End Sub
 
Sub SupprDoublons(onglet)
som = Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
derniereCol = Worksheets(onglet).Range("A1").End(xlToRight).Column
 
Range("A2", Chr(derniereCol + 64) & som).RemoveDuplicates Columns:=Array(1)
 
End Sub
Sub Generer_onglets_contributeur_Rempli()
'enlever le volet figer sur listetotal avant de faire les calculs
ActiveWorkbook.Worksheets("MetierContributeurs").Activate
'ActiveWindow.FreezePanes = False
 
'generer les portefeuilles
Dim onglet As String
Dim plage As String
 
'instance = Array("CMEG", "CSCT", "IVCT")
Application.DisplayAlerts = False
On Error Resume Next
 
With ActiveWorkbook.Worksheets("MetierContributeurs")
'------------------------------------------------------------
If Worksheets("MetierContributeurs").FilterMode = True Then Worksheets("MetierContributeurs").ShowAllData 'enleve les filtres s'il y en a
macolonne = .Range("A1").End(xlToRight).Column 'nb de colonne
' recherche la bonne colonne dans "Données_Calcul_%" et declare une variable
    For b = 1 To macolonne
         If Cells(1, b).Value = "statut reactivite" Then
            ColStatut = b
        End If
        If Cells(1, b).Value = "Désignation" Then
            ColCont = b
        End If
 
         If Cells(1, b).Value = "Priorite_Impact_FT" Then ' avant priorité
           ColPriorite = b
          ' MsgBox "la colonne :Priorite_Impact_FT" & " a pour num de col : " & b & Chr(j + 64)
        End If
        If Cells(1, b).Value = "dans délai obj" Then ' '"dans hors"'
        colDelai = b
       ' MsgBox "la colonne : Respect délai objectif" & " a pour b de col : " & b
        End If
        If Cells(1, b).Value = "dans délai limite" Then '"delai limite"
        ColDelaiLimite = b
        'MsgBox "la colonne : Respect délai limite" & " a pour b de col : " & b
        End If
 
        If Cells(1, b).Value = "Année solution réactivité" Then
        ColAnne = b
        End If
        If Cells(1, b).Value = "impact Total " Then
        ColDelaiTotal = b
        'MsgBox "col impact total : " & b
        End If
    Next b
 
    'Metier = Array("DCTC ", "PCTD ", "PCTE ", "PBCH ", "CMEG", "CSCT", "IVCT")
    Metier = Array("ICDV", "IACT", "CMEG", "CSCT", "IVCT", "DSEE")
    For m = LBound(Metier) To UBound(Metier)
 
    Select Case Metier(m)
 
 
       '----
         Case "ICDV":
            filtre1 = Array("=*ICDV*")
            col = ColCont
            onglet = "ICDV Contributeurs"
            onglet2 = "ICDV Contributeurs Pas"
            cel = "P15"
        Case "IACT":
            filtre1 = Array("=*iact*")
            col = ColCont
            onglet = "IACT Contributeurs"
            onglet2 = "IACT Contributeurs Pas"
            cel = "P19"
        Case "CMEG":
            filtre1 = Array("=*CMEG*")
            col = ColCont
            onglet = "CMEG Contributeurs"
            onglet2 = "CMEG Contributeurs Pas"
            cel = "P23"
        Case "CSCT":
            filtre1 = Array("=*CSCT*")
            col = ColCont
            onglet = "CSCT Contributeurs"
            onglet2 = "CSCT Contributeurs Pas"
            cel = "P27"
        Case "IVCT":
            filtre1 = Array("=*IVCT*")
            col = ColCont
            onglet = "IVCT Contributeurs"
            onglet2 = "IVCT Contributeurs Pas"
            cel = "P31"
         Case "DSEE":
         filtre1 = Array("=*DSEE*")
            col = ColCont
            onglet = "DSEE Contributeurs"
            onglet2 = "DSEE Contributeurs Pas"
 
    End Select
 
    ' ajoute a la fin
    Sheets(onglet).Delete
    'MsgBox Metier(m) & ", " & onglet
    Sheets.Add.Move After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = onglet
 
    f = Array("Prio 40 J", "Prio 120 J")
 
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre1, Operator:=xlFilterValues 'choix de l'instance
    .Cells(1, 1).AutoFilter Field:=ColPriorite, Criteria1:=f, Operator:=xlFilterValues 'Filtre :choix de priorité diff de en en fenetre et vide
    '.Cells(1, 1).AutoFilter Field:=3, Criteria1:="="
 
 
     som = .Cells(Rows.Count, "A").End(xlUp).Row
    ' MsgBox Metier(m) & "somme : " & som
 
     'plage = "A1:BU" & som
 
 
 
    Worksheets("MetierContributeurs").Activate
    Range("A1:Q" & som).Select 'attention si on change supr col
    Selection.Copy
    Worksheets(onglet).Activate
    Range("A1").Select
    ActiveSheet.Paste
 
 
    macolonne = Worksheets(onglet).Range("A1").End(xlToRight).Column
    Worksheets(onglet).AutoFilterMode = False
    Worksheets(onglet).Range(Worksheets(onglet).Cells(1, 1), Worksheets(onglet).Cells(1, macolonne)).AutoFilter
 
    Call SupprDoublons(onglet)
 
    If Metier(m) <> "DSEE" Then
    '-----
    somTotal = 0
    somDelaiObj = 0
    somDelaiLim = 0
 
    Worksheets(onglet).Cells(1, 1).AutoFilter Field:=ColStatut, Criteria1:="traité", Operator:=xlFilterValues
 
    Worksheets(onglet).Cells(1, 1).AutoFilter Field:=ColAnne, Criteria1:="2014", Operator:=xlFilterValues 'Filtre : Choix de l'année
 
    Set MaPlage = Worksheets(onglet).UsedRange.SpecialCells(xlCellTypeVisible)
 
        For Each ligne In MaPlage.Rows
            If ligne.Cells(ColDelaiTotal).Value <> "impact Total " Then
 
                'MsgBox "valeur : " & Ligne.Cells(ColDelaiTotal).Value
                somTotal = somTotal + ligne.Cells(ColDelaiTotal).Value
                somDelaiObj = somDelaiObj + ligne.Cells(colDelai).Value
                somDelaiLim = somDelaiLim + ligne.Cells(ColDelaiLimite).Value
 
            End If
        Next ligne
   ' MsgBox Metier(m) & "total :" & somTotal & ", obj : " & somDelaiObj & ", lim :" & somDelaiLim
    Set MaPlage = Nothing
 
        'reinitialise les filtres
        If Worksheets(onglet).FilterMode = True Then Worksheets(onglet).ShowAllData
 
        'copie les valeurs dans synthese
    Worksheets("Synthèse_Résultats").Range(cel).Value = somTotal 'copie dans synthèse som
    coll = Range(cel).Column 'recupere le numero de colonne
    cel = Replace(cel, Left(cel, 1), Chr(coll + 65)) ' chr(65) equivaux a "A" ,Donc  ici j'incremente avec des lettres
    Worksheets("Synthèse_Résultats").Range(cel).Value = somDelaiObj ' copie somDelaiObj dans la case d'a coter
 
    cel = Replace(cel, Left(cel, 1), Chr(coll + 66))
    Worksheets("Synthèse_Résultats").Range(cel).Value = somTotal
    cel = Replace(cel, Left(cel, 1), Chr(coll + 67))
    Worksheets("Synthèse_Résultats").Range(cel).Value = somDelaiLim
    End If
 
    '----
 
 
    Call Tri_Liste_Statut_Prio_delais_Contributeurs(onglet)
 
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColPriorite, Criteria1:="<>", Operator:=xlFilterValues
   ' .Cells(1, 1).AutoFilter Field:=ColCont, Criteria1:="<>"
    .ShowAllData
    Next m
 
 
 
 End With
 
End Sub
 
 
Sub Generer_onglet_contributeurs_Anomalie()
 
ActiveWorkbook.Worksheets("MetierContributeurs").Activate
 
Dim onglet As String
Dim plage As String
 
Application.DisplayAlerts = False
On Error Resume Next
 
With ActiveWorkbook.Worksheets("MetierContributeurs")
'------------------------------------------------------------
If Worksheets("MetierContributeurs").FilterMode = True Then Worksheets("MetierContributeurs").ShowAllData 'enleve les filtres s'il y en a
macolonne = .Range("A1").End(xlToRight).Column 'nb de colonne
' recherche la bonne colonne dans "Données_Calcul_%" et declare une variable
    For b = 1 To macolonne
        If Cells(1, b).Value = "Désignation" Then
            ColCont = b
        End If
    Next b
 
    onglet = "anomalies"
    ongletAvant = "MetierContributeurs"
    ' ajoute a la fin
    Sheets(onglet).Delete
    Sheets.Add.Move After:=Sheets(ongletAvant)
    numNewPasRemp = (Worksheets(ongletAvant).Index) + 1
    Sheets(numNewPasRemp).Name = onglet
 
 
    .Cells(1, 1).AutoFilter Field:=ColCont, Criteria1:="="
 
     som = .Cells(Rows.Count, "A").End(xlUp).Row
    ' MsgBox Metier(m) & "somme : " & som
 
 
    Worksheets("MetierContributeurs").Activate
    Range("A1:Q" & som).Select 'attention si on change supr col
    Selection.Copy
    Worksheets(onglet).Activate
    Range("A1").Select
    ActiveSheet.Paste
 
 
' onglet trie ?
 
    macolonne = Worksheets(onglet).Range("A1").End(xlToRight).Column
    Worksheets(onglet).AutoFilterMode = False
    Worksheets(onglet).Range(Worksheets(onglet).Cells(1, 1), Worksheets(onglet).Cells(1, macolonne)).AutoFilter
 
 
    .Cells(1, 1).AutoFilter Field:=ColCont, Criteria1:="<>"
    .ShowAllData
 
 
 
 End With
 
End Sub
 
 
Function FeuilleInexistante(ByVal strNomFeuille As String) As Boolean
'Retourne TRUE si strNomFeuille est le nom d'une feuille qui n'existe pas dans le classeur actif
 
FeuilleInexistante = IsError(Evaluate("='" & strNomFeuille & "'!A1"))
 
End Function
 
Function OngletRequeteAltisTE() As Boolean
 
    Dim strNomFeuille As String
    Dim strNomFeuille2 As String
    strNomFeuille = "32.Métiers Contributeurs"
    strNomFeuille2 = "32.Métiers Contributeurs (2)"
    If FeuilleInexistante(strNomFeuille) Or FeuilleInexistante(strNomFeuille2) Then
    MsgBox " Ces feuilles n'existent pas dans le classeur " & strNomFeuille & ", " & strNomFeuille2
    OngletRequeteAltisTE = False
    Else
    OngletRequeteAltisTE = True
    End If
 
End Function

Je vous remercie d'avance!!
Nom : onglet1erpartie.png
Affichages : 430
Taille : 30,4 Ko <-------------------- screen pour l'affichage des 2 collones.
Nom : ongletvide.png
Affichages : 416
Taille : 29,3 Ko <-------------------- screen pour la feuille que je n'arrive pas a afficher.

Cordialement