Création de ligne rentrée en dur.A faire en auto

**Mehdi8793** · 12/11/2014, 13h52

Bonjour,

Etant en stage, je devellope en VBA. J'ai un probleme de compréhension concernant :
J'ai une page généré par une macro. Elle me genere des données pour une question non traité et une question traité. Les traités se place juste en dessous des non traité, mon problème est que j'aimerai afficher en ligne 2 "Liste des question traitées" puis a la fin de ses questions traitées avoir une ligne qui affiche les non traitées. Le problème lorsque je le fais en dur cela est bon mais quand je lance ma macro tout disparait à la fin de la maj.

Je pense qui me suffit juste de l'intégrer à ma macro? mais je ne comprends pas comment m'y prendre.

PS: Voici le résultat voulu sur l'image en dur avant l'execution de la macro.

Cordialement et merci d'avance pour votre aide.

Nom : traiter.png
Affichages : 245
Taille : 84,3 Ko

Nom : traiter.png
Affichages : 245
Taille : 84,3 Ko

**AlainTech** · 15/11/2014, 17h49

Bonjour,

Oui... Et où est la macro?

**Mehdi8793** · 17/11/2014, 08h41

Bonjour,

Voici la macro elle est longue.

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
 
Sub Generer_Les_PFSolution()
ActiveWorkbook.Worksheets("liste_total").Activate
'ActiveWindow.FreezePanes = False
 
'generer les portefeuilles
Dim onglet As String
Dim plage As String
Dim ongletAvant As String
instance = Array("IACT", "ICDV", "MOA PCTD", "MOA PCTE", "MOA PBCH")
 
Application.DisplayAlerts = False
 
 
With ActiveWorkbook.Worksheets("liste_total")
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 = "Metier Pilote N2" Then
            MetierPD = b
        End If
        If Cells(1, b).Value = "Année solution réactivité" Then
            DatePT = b
        End If
         If Cells(1, b).Value = "statut reactivite" Then
            ColStatutR = b
        End If
        If .Cells(1, b).Value = "Metier_Pilote_N3" Then
            MetierPN3 = b
        End If
        If .Cells(1, b).Value = "Instance Décisionnelle FT" Then
            inst = b
        End If
        If Cells(1, b).Value = "Effet client" Then
        ColEffet = b
        End If
        If Cells(1, b).Value = "Etat Avancement actuel FT" Then
        ColEtat = b
        End If
        If Cells(1, b).Value = "Metier Pilote FT" Then
        ColFT = b
        End If
    Next b
 
 
'------------------------------------------------------------
For m = LBound(instance) To UBound(instance)
If Worksheets("liste_total").FilterMode = True Then Worksheets("liste_total").ShowAllData 'enleve les filtres s'il y en a
 
    Select Case instance(m)
    '_________________________ LES FILTRES METIERS ________________________________
    Case "IACT":
    onglet = "PF IACT Sol"
    ongletAvant = "PF IACT"
    filtre = "DRD/DCTC/IACT"
    Case "ICDV":
    onglet = "PF ICDV Sol"
    ongletAvant = "PF ICDV"
    filtre = "=DRD/DCTC/ICDV"
    filtre2 = "=ILDR"
    '____________________________ LES FILTRES MOA___________________________
      Case "MOA PCTD":
    onglet = "PF MOA-PCTD Sol"
    ongletAvant = "PF MOA-PCTD"
    filtre = Array("=Qualité série DT", "=Qualité série DV", "=Qualité série DW", "=Qualité série PUMA")
    Case "MOA PCTE":
    onglet = "PF MOA-PCTE Sol"
     ongletAvant = "PF MOA-PCTE"
    filtre = Array("=Qualité série EP", "=Qualité série EB", "=Qualité série TU", "=Qualité série EW")
    Case "MOA PBCH":
    onglet = "PF MOA-PBCH Sol"
    ongletAvant = "PF MOA-PBCH"
    filtre = Array("=Qualité série BE", "=Qualité série BVA", "=Qualité série GMP HY", "=Qualité série MA", _
    "=Qualité série MAP", "=Qualité série MCM", "=Qualité série MCP", "=Qualité série ML", "=Qualité série MAPS", "=Qualité Série STT", "=Qualité série STTd")
    '________________________________________________________________________
 
    End Select
 
    'ajoute apres l'ongletAVANT
    Sheets(onglet).Delete
    Sheets.Add.Move After:=Sheets(ongletAvant)
    numNewPF = (Worksheets(ongletAvant).Index) + 1
    Sheets(numNewPF).Name = onglet
    'MsgBox instance(m) & ", " & numNewPF & "apres : " & ongletAvant
    annee = Array("2013", "2014")
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="traité", Operator:=xlFilterValues ' en cours
    .Cells(1, 1).AutoFilter Field:=ColEffet, Criteria1:="Effet client avéré", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEtat, Criteria1:="SOLUTION EN COURS", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:=annee, Operator:=xlFilterValues 'Filtre : Choix de l'année
   ' .Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:="*2013*", Operator:=xlOr, Criteria2:="*2014*"
    '.Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:=">31/12/2012", Operator:=xlAnd 'Filtre : Choix de l'année
    .Cells(1, 1).AutoFilter Field:=ColFT, Criteria1:="<>(Hors Metier)", Operator:=xlAnd  ' different de horsmetiers
 
    If instance(m) = "IACT" Or instance(m) = "ICDV" Then ' MOE
    'MsgBox instance(m) & "trie sur dctc et sur Metier PN3"
        col = MetierPN3
        '.Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="DCTC", Operator:=xlFilterValues 'Filtre : DCTC dans la colonne "Metier Pilote N2
        If instance(m) = "ICDV" Then
        .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre _
        , Operator:=xlOr, Criteria2:=filtre2
        '.Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues '
        Else 'iact
        .Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="DCTC", Operator:=xlFilterValues 'Filtre : DCTC dans la colonne "Metier Pilote N2
         .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues
        End If
 
    Else
    'MsgBox instance(m) & "trie sur instance decisionnel"
    col = inst
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues '
    End If
 
 
 
 
     som = .Cells(Rows.Count, "A").End(xlUp).Row
    ' MsgBox instance(m) & "somme : " & som
 
 
    Worksheets("liste_total").Activate
    Range("A1:BU" & som).Select
    Selection.Copy
    Worksheets(onglet).Activate
    Range("A1").Select
    ActiveSheet.Paste
 
    Call suppreColInutile(onglet)
 
 
 
 
    Call triPourDernierLigneCalcul(onglet)
    Call ajouteImpact(onglet)
 
 
    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 Tri_Liste_Prio_delais2(onglet)
 
    Call copiesolution(onglet, ongletAvant) ' apeler apres avoir fait longlet moa iact icdv
 
    'reinitialise les filtres de la liste total
    If instance(m) = "IACT" Then ' MOE
        .Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="<>", Operator:=xlFilterValues
    End If
 
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEffet, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEtat, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:="<>", Operator:=xlFilterValues 'Filtre : Choix de l'année
    .Cells(1, 1).AutoFilter Field:=ColFT, Criteria1:="<>", Operator:=xlAnd
    Next m
 
 
 
 End With
 
End Sub
 
Sub copiesolution(onglet, ongletAvant)
    som = Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
    Worksheets(onglet).Activate
    Range("A2:BU" & som).Select
    Selection.Copy
    Worksheets(ongletAvant).Activate
    dernLig = Worksheets(ongletAvant).Cells(Rows.Count, "A").End(xlUp).Row
    'MsgBox onglet & " derniere ligne : " & dernLig
    Range("A" & dernLig + 1).Select
    ActiveSheet.Paste
 
End Sub
 
 
 
Sub solutionalafin()
    '
    onglet = "PF SurveillanceTotal"
    ongletTotal = "PF Total"
 
   ' Sheets(onglet).Delete enlever car suppr a la fin ce cete methode
    Sheets.Add.Move After:=Sheets(ongletTotal)
    numNewPF = (Worksheets(ongletTotal).Index) + 1
    Sheets(numNewPF).Name = onglet
 
    'entete et iact
    ongletSelec = "PF IACT Surv"
    Worksheets(ongletSelec).Activate
    Range("A1:Q1").Select
    Selection.Copy
    Worksheets(onglet).Activate
    dernLig = Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1").Select
    ActiveSheet.Paste
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF MOA-PCTE Surv"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF MOA-PBCH Surv"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF ICDV Surv"
    Call copiePF(ongletSelec, onglet)
 
    'enlever filtre sur surveillance mettre filtre prio puis copier puis remetre filtre initial
 
    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 Tri_Liste_Prio_delais2(onglet)
    Call copiePF(onglet, ongletTotal)
 
    Sheets(onglet).Delete
 
End Sub

Cette macro me permet d'afficher les questions traités, pour les questions non traitées j'ai une autre macro.
Pour pouvoir séparer automatiquement grace à ces deux lignes les question traitées et non traitées. Je ne sais pas ou mis prendre je débute en VBA et c'est pas très clair.

Cordialement

MErci de votre aide.

**Mehdi8793** · 17/11/2014, 09h25

Je précise:

Cette onglet en screan est généré grace à 2 macros (, mais ou et comment j'ajoute mes 2 lignes dans quelle macro? pour avoir le résultat).

voici les 2 macro:

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
 
Sub Generer_Les_PFSurv()
ActiveWorkbook.Worksheets("liste_total").Activate
'ActiveWindow.FreezePanes = False
 
'generer les portefeuilles
Dim onglet As String
Dim plage As String
Dim ongletAvant As String
instance = Array("IACT", "ICDV", "MOA PCTD", "MOA PCTE", "MOA PBCH")
 
Application.DisplayAlerts = False
 
 
With ActiveWorkbook.Worksheets("liste_total")
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 = "Metier Pilote N2" Then
            MetierPD = b
        End If
        If Cells(1, b).Value = "Année solution réactivité" Then
            DatePT = b
        End If
         If Cells(1, b).Value = "statut reactivite" Then
            ColStatutR = b
        End If
        If .Cells(1, b).Value = "Metier_Pilote_N3" Then
            MetierPN3 = b
        End If
        If .Cells(1, b).Value = "Instance Décisionnelle FT" Then
            inst = b
        End If
        If Cells(1, b).Value = "Effet client" Then
        ColEffet = b
        End If
        If Cells(1, b).Value = "Etat Avancement actuel FT" Then
        ColEtat = b
        End If
        If Cells(1, b).Value = "Metier Pilote FT" Then
        ColFT = b
        End If
    Next b
 
 
'------------------------------------------------------------
For m = LBound(instance) To UBound(instance)
If Worksheets("liste_total").FilterMode = True Then Worksheets("liste_total").ShowAllData 'enleve les filtres s'il y en a
 
    Select Case instance(m)
    '_________________________ LES FILTRES METIERS ________________________________
    Case "IACT":
    onglet = "PF IACT Surv"
    ongletAvant = "PF IACT"
    filtre = "DRD/DCTC/IACT"
    Case "ICDV":
    onglet = "PF ICDV Surv"
    ongletAvant = "PF ICDV"
    filtre = "=DRD/DCTC/ICDV"
    filtre2 = "=ILDR"
    '____________________________ LES FILTRES MOA___________________________
      Case "MOA PCTD":
    onglet = "PF MOA-PCTD Surv"
    ongletAvant = "PF MOA-PCTD"
    filtre = Array("=Qualité série DT", "=Qualité série DV", "=Qualité série DW", "=Qualité série PUMA")
    Case "MOA PCTE":
    onglet = "PF MOA-PCTE Surv"
     ongletAvant = "PF MOA-PCTE"
    filtre = Array("=Qualité série EP", "=Qualité série EB", "=Qualité série TU", "=Qualité série EW")
    Case "MOA PBCH":
    onglet = "PF MOA-PBCH Surv"
    ongletAvant = "PF MOA-PBCH"
    filtre = Array("=Qualité série BE", "=Qualité série BVA", "=Qualité série GMP HY", "=Qualité série MA", _
    "=Qualité série MAP", "=Qualité série MCM", "=Qualité série MCP", "=Qualité série ML", "=Qualité série MAPS", "=Qualité Série STT", "=Qualité série STTd")
    '________________________________________________________________________
 
    End Select
 
    'ajoute apres l'ongletAVANT
    Sheets(onglet).Delete
    Sheets.Add.Move After:=Sheets(ongletAvant)
    numNewPF = (Worksheets(ongletAvant).Index) + 1
    Sheets(numNewPF).Name = onglet
    'MsgBox instance(m) & ", " & numNewPF & "apres : " & ongletAvant
    annee = Array("2013", "2014")
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="traité", Operator:=xlFilterValues ' en cours
    .Cells(1, 1).AutoFilter Field:=ColEffet, Criteria1:="Effet client avéré", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEtat, Criteria1:="SURVEILLANCE", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:=annee, Operator:=xlFilterValues 'Filtre : Choix de l'année
   ' .Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:="*2013*", Operator:=xlOr, Criteria2:="*2014*"
    '.Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:=">31/12/2012", Operator:=xlAnd 'Filtre : Choix de l'année
    .Cells(1, 1).AutoFilter Field:=ColFT, Criteria1:="<>(Hors Metier)", Operator:=xlAnd  ' different de horsmetiers
 
    If instance(m) = "IACT" Or instance(m) = "ICDV" Then ' MOE
    'MsgBox instance(m) & "trie sur dctc et sur Metier PN3"
        col = MetierPN3
        '.Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="DCTC", Operator:=xlFilterValues 'Filtre : DCTC dans la colonne "Metier Pilote N2
        If instance(m) = "ICDV" Then
        .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre _
        , Operator:=xlOr, Criteria2:=filtre2
        '.Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues '
        Else 'iact
        .Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="DCTC", Operator:=xlFilterValues 'Filtre : DCTC dans la colonne "Metier Pilote N2
         .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues
        End If
 
    Else
    'MsgBox instance(m) & "trie sur instance decisionnel"
    col = inst
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues '
    End If
 
 
 
 
     som = .Cells(Rows.Count, "A").End(xlUp).Row
    ' MsgBox instance(m) & "somme : " & som
 
 
    Worksheets("liste_total").Activate
    Range("A1:BU" & som).Select
    Selection.Copy
    Worksheets(onglet).Activate
    Range("A1").Select
    ActiveSheet.Paste
 
    Call suppreColInutile(onglet)
 
 
' 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("A2:A" & l), SortOn:=xlSortOnValues, Order:=xlAscending, 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("K2:K" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    '    :=xlSortNormal
 
   'With ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort
    '   .Header = xlYes
     '  .MatchCase = False
      ' .Orientation = xlTopToBottom
       '.SortMethod = xlPinYin
       '.Apply
   'End With
 
    Call triPourDernierLigneCalcul(onglet)
    Call ajouteImpact(onglet)
   ' MsgBox instance(m) & "num derniereligne pr select  : " & Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
   ' MsgBox instance(m) & "num derniereligne ajoute a la fin   : " & Worksheets(ongletAvant).Cells(Rows.Count, "A").End(xlUp).Row
    'Call copi dans onglet General
 
    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 Tri_Liste_Prio_delais2(onglet)
    'MsgBox instance(m) & "num derniereligne pr select  : " & Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
    'MsgBox instance(m) & "num derniereligne ajoute a la fin   : " & Worksheets(ongletAvant).Cells(Rows.Count, "A").End(xlUp).Row
 
    Call copiesurv(onglet, ongletAvant) ' apeler apres avoir fait longlet moa iact icdv
 
    'reinitialise les filtres de la liste total
    If instance(m) = "IACT" Then ' MOE
        .Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="<>", Operator:=xlFilterValues
    End If
 
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEffet, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEtat, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=DatePT, Criteria1:="<>", Operator:=xlFilterValues 'Filtre : Choix de l'année
    .Cells(1, 1).AutoFilter Field:=ColFT, Criteria1:="<>", Operator:=xlAnd
    Next m
 
 
 
 End With
 
End Sub
 
Sub copiesurv(onglet, ongletAvant)
    som = Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
    Worksheets(onglet).Activate
    Range("A2:BU" & som).Select
    Selection.Copy
    Worksheets(ongletAvant).Activate
    dernLig = Worksheets(ongletAvant).Cells(Rows.Count, "A").End(xlUp).Row
    'MsgBox onglet & " derniere ligne : " & dernLig
    Range("A" & dernLig + 1).Select
    ActiveSheet.Paste
 
End Sub
 
 
 
Sub survalafin()
    '
    onglet = "PF SurveillanceTotal"
    ongletTotal = "PF Total"
 
   ' Sheets(onglet).Delete enlever car suppr a la fin ce cete methode
    Sheets.Add.Move After:=Sheets(ongletTotal)
    numNewPF = (Worksheets(ongletTotal).Index) + 1
    Sheets(numNewPF).Name = onglet
 
    'entete et iact
    ongletSelec = "PF IACT Surv"
    Worksheets(ongletSelec).Activate
    Range("A1:Q1").Select
    Selection.Copy
    Worksheets(onglet).Activate
    dernLig = Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1").Select
    ActiveSheet.Paste
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF MOA-PCTE Surv"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF MOA-PBCH Surv"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF ICDV Surv"
    Call copiePF(ongletSelec, onglet)
 
    'enlever filtre sur surveillance mettre filtre prio puis copier puis remetre filtre initial
 
    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 Tri_Liste_Prio_delais2(onglet)
    Call copiePF(onglet, ongletTotal)
 
    Sheets(onglet).Delete
 
End Sub

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
 
 
 
'Function copierAvecParam(onglet As String, plage As String)
   '  Sheets(onglet).Range(plage) = Sheets("liste_total").Range(plage).Value
'End Function
 
 
 
Function suppreColInutile(onglet As String)
'suppr les col inutile dans l'onglet passer en parametre
 
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", "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", "statut reactivite", "Nb jour restant", "date solution réactivité prévisionnelle", "date solution réactivité réelle", "Mois d 'application solution réactivité", "Année 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", "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 Function
 
Sub Tri_Liste_Prio_delais2(onglet)
With Worksheets(onglet)
 l = .Range("A1").End(xlDown).Row
' MsgBox "l: " & l
 
'trie par 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("J1:J" & 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("K2:K" & l), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
 
    With ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '.Columns("B:J").EntireColumn.AutoFit
 
 
End With
End Sub
Sub appel_PFs()
Call Generer_Les_PF
Call MacroReunirPF 'PF TOTAL
 
Call Generer_Les_PFSurv 'appel apres avoir generer liste pf total (MacroReunirPF) sans surveillance (pour mettre les surveillance a la fin de PF Total
Call Generer_Les_PFSolution
Call survalafin
End Sub
Sub Generer_Les_PF()
'enlever le volet figer sur listetotal avant de faire les calculs
ActiveWorkbook.Worksheets("liste_total").Activate
'ActiveWindow.FreezePanes = False
 
'generer les portefeuilles
Dim onglet As String
Dim plage As String
 
instance = Array("IACT", "ICDV", "MOA PCTD", "MOA PCTE", "MOA PBCH")
 
Application.DisplayAlerts = False
 
 
With ActiveWorkbook.Worksheets("liste_total")
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 = "Metier Pilote N2" Then
            MetierPD = b
        End If
        If Cells(1, b).Value = "Accord Analyse" Then
            DatePT = b
        End If
         If Cells(1, b).Value = "statut reactivite" Then
            ColStatutR = b
        End If
        If .Cells(1, b).Value = "Metier_Pilote_N3" Then
            MetierPN3 = b
        End If
        If .Cells(1, b).Value = "Instance Décisionnelle FT" Then
            inst = b
        End If
        If Cells(1, b).Value = "Effet client" Then
        ColEffet = b
        End If
    Next b
 
 
'------------------------------------------------------------
For m = LBound(instance) To UBound(instance)
If Worksheets("liste_total").FilterMode = True Then Worksheets("liste_total").ShowAllData 'enleve les filtres s'il y en a
 
    Select Case instance(m)
    '_________________________ LES FILTRES METIERS ________________________________
    Case "IACT":
    onglet = "PF IACT"
    ongletAvant = "TdB_IACT"
    filtre = "DRD/DCTC/IACT"
    Case "ICDV":
    onglet = "PF ICDV"
    ongletAvant = "TdB_ICDV"
    filtre = "=DRD/DCTC/ICDV"
    filtre2 = "=ILDR"
    '____________________________ LES FILTRES MOA___________________________
      Case "MOA PCTD":
    onglet = "PF MOA-PCTD"
    ongletAvant = "TdB_PCTD"
    filtre = Array("=Qualité série DT", "=Qualité série DV", "=Qualité série DW", "=Qualité série PUMA")
    Case "MOA PCTE":
    onglet = "PF MOA-PCTE"
    ongletAvant = "TdB_PCTE"
    filtre = Array("=Qualité série EP", "=Qualité série EB", "=Qualité série TU", "=Qualité série EW")
    Case "MOA PBCH":
    onglet = "PF MOA-PBCH"
    ongletAvant = "TdB_PBCH"
    filtre = Array("=Qualité série BE", "=Qualité série BVA", "=Qualité série GMP HY", "=Qualité série MA", _
    "=Qualité série MAP", "=Qualité série MCM", "=Qualité série MCP", "=Qualité série ML", "=Qualité série MAPS", "=Qualité Série STT", "=Qualité série STTd")
    '________________________________________________________________________
 
    End Select
 
    ' ajoute a la fin
    'Sheets(onglet).Delete
    'Sheets.Add.Move After:=Sheets(Sheets.Count)
    'Sheets(Sheets.Count).Name = onglet
 
    'ajoute apres l'ongletAVANT
    Sheets(onglet).Delete
    Sheets.Add.Move After:=Sheets(ongletAvant)
    numNewPF = (Worksheets(ongletAvant).Index) + 1
    Sheets(numNewPF).Name = onglet
    'MsgBox instance(m) & ", " & numNewPF & "apres : " & ongletAvant
 
 
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="Encours", Operator:=xlFilterValues ' en cours
    .Cells(1, 1).AutoFilter Field:=ColEffet, Criteria1:="Effet client avéré", Operator:=xlFilterValues
    If instance(m) = "IACT" Or instance(m) = "ICDV" Then ' MOE
    'MsgBox instance(m) & "trie sur dctc et sur Metier PN3"
        col = MetierPN3
        '.Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="DCTC", Operator:=xlFilterValues 'Filtre : DCTC dans la colonne "Metier Pilote N2
        If instance(m) = "ICDV" Then
        .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre _
        , Operator:=xlOr, Criteria2:=filtre2
        '.Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues '
        Else 'iact
        .Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="DCTC", Operator:=xlFilterValues 'Filtre : DCTC dans la colonne "Metier Pilote N2
         .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues
        End If
 
    Else
    'MsgBox instance(m) & "trie sur instance decisionnel"
    col = inst
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues '
    End If
 
 
    '.Cells(1, 1).AutoFilter Field:=col, Criteria1:=filtre, Operator:=xlFilterValues 'choix de l'instance
 
     'som = Application.Subtotal(3, .Range("A:A"))
     som = .Cells(Rows.Count, "A").End(xlUp).Row
     'MsgBox instance(m) & "somme : " & som
 
     'plage = "A1:BU" & som
 
 
 
    Worksheets("liste_total").Activate
    Range("A1:BU" & som).Select
    Selection.Copy
    Worksheets(onglet).Activate
    Range("A1").Select
    ActiveSheet.Paste
 
    Call suppreColInutile(onglet)
 
 
' 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("A2:A" & l), SortOn:=xlSortOnValues, Order:=xlAscending, 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("K2:K" & l), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    '    :=xlSortNormal
 
 
   ' With ActiveWorkbook.Worksheets(onglet).AutoFilter.Sort
       ' .Header = xlYes
       ' .MatchCase = False
       ' .Orientation = xlTopToBottom
      '  .SortMethod = xlPinYin
     '   .Apply
    'End With
    Call triPourDernierLigneCalcul(onglet)
    Call ajouteImpact(onglet)
 
 
    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 Tri_Liste_Prio_delais2(onglet)
 
    'reinitialise les filtres de la liste total
    If instance(m) = "IACT" Then ' MOE
        .Cells(1, 1).AutoFilter Field:=MetierPD, Criteria1:="<>", Operator:=xlFilterValues
    End If
 
    .Cells(1, 1).AutoFilter Field:=col, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="<>", Operator:=xlFilterValues
    .Cells(1, 1).AutoFilter Field:=ColEffet, Criteria1:="<>", Operator:=xlFilterValues
    Next m
 
 
 
 End With
 
End Sub
 
Sub PFTotalTraité()
Dim ongletTraité As String
Dim ColStatutR As Integer
 
ongletTraité = "Liste traitées"
 
    'ajoute apres l'ongletAVANT
    Sheets(ongletTraité).Delete
    Sheets.Add.Move After:=Sheets("liste_total")
    numNewPF = (Worksheets("liste_total").Index) + 1
    Sheets(numNewPF).Name = ongletTraité
 
With Worksheets("liste_total")
 
macolonne = .Range("A1").End(xlToRight).Column 'nb de colonne
 'MsgBox "col : " & macolonne
   For b = 1 To macolonne
         If .Cells(1, b).Value = "statut reactivite" Then
            ColStatutR = b
        End If
 
   Next b
 
 
    .Cells(1, 1).AutoFilter Field:=ColStatutR, Criteria1:="traité", Operator:=xlFilterValues
 
    som = .Cells(Rows.Count, "A").End(xlUp).Row
    Worksheets("liste_total").Activate
    Range("A1:BU" & som).Select
    Selection.Copy
    Worksheets(ongletTraité).Activate
    Range("A1").Select
    ActiveSheet.Paste
 
    Call TriPrioDateSol_Traité
 
    End With
End Sub
Sub TriPrioDateSol_Traité()
 
With Worksheets("Liste traitées")
 
    macolonne = .Range("A1").End(xlToRight).Column
    .AutoFilterMode = False
    .Range(.Cells(1, 1), .Cells(1, macolonne)).AutoFilter
 
l = .Range("A1").End(xlDown).Row
 
    .AutoFilter.Sort.SortFields.Clear
 
    .AutoFilter.Sort.SortFields.Add Key:= _
        Range("AB1:AB" & l), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
        := _
        "Prio 40 J,Prio 120 J,En Fenêtre" _
        , DataOption:=xlSortNormal
 
    .AutoFilter.Sort.SortFields.Add Key _
        :=Range("AN1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
 
    With ActiveWorkbook.Worksheets("Liste traitées").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End With
 
 
 
End Sub
Sub ajouteImpact(onglet)
'calcul les impacts pour chaque reference (imact total impact 120,40 fenetre et autre)
 
 Worksheets(onglet).Activate
 impact_total = 1
 
 
 With Worksheets(onglet)
 
 If .Cells(2, 10).Value = "Prio 40 J" Then
    impact_40 = 1 '
    impact_120 = 0 '
    impact_fen = 0 '
    impact_autre = 0
    End If
If .Cells(2, 10).Value = "Prio 120 J" Then
    impact_40 = 0 '
    impact_120 = 1 '
    impact_fen = 0 '
    impact_autre = 0
End If
If .Cells(2, 10).Value = "En Fenêtre" Then
    impact_40 = 0 '
    impact_120 = 0 '
    impact_fen = 1 '
    impact_autre = 0
End If
If .Cells(2, 10).Value = "Autre" Then
    impact_40 = 0 '
    impact_120 = 0 '
    impact_fen = 0 '
    impact_autre = 1
End If
 
 
 
   macolonne = .Range("A1").End(xlToRight).Column
    'ajoute la col impact
    som = .Cells(Rows.Count, "A").End(xlUp).Row
    'MsgBox som
    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "M") = "impact Total "
 
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "N") = "impact 40 "
 
    Columns("O:O").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "O") = "impact 120 "
 
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "P") = "impact fen "
 
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight
    Selection.ClearFormats
    .Cells(1, "Q") = "impact autre "
 
   'calcul l'impact et le met sur la col impact et dans la ligne correspondante
    For numLigne = 2 To som
       If .Cells(numLigne, 1).Value = .Cells(numLigne + 1, 1).Value Then 'si c'est la meme ref
            'MsgBox NumLigne & " , " & .Cells(NumLigne, 1).Value
 
            If .Cells(numLigne, 10).Value = .Cells(numLigne + 1, 10).Value Then ' a tester
                If .Cells(numLigne, 10).Value = "Prio 40 J" Then
                impact_40 = impact_40 + 1 '
                End If
                If .Cells(numLigne, 10).Value = "Prio 120 J" Then
                impact_120 = impact_120 + 1 '
                End If
                If .Cells(numLigne, 10).Value = "En Fenêtre" Then
                impact_fen = impact_fen + 1 '
                End If
                If .Cells(numLigne, 10).Value = "Autre" Then
                impact_autre = impact_autre + 1 '
                End If '
 
            Else 'probleme car premier ligne impact pas =0 mais a 1 mais lequel ?
 
                If .Cells(numLigne + 1, 10).Value = "Prio 40 J" Then
                impact_40 = impact_40 + 1 '
                End If
                If .Cells(numLigne + 1, 10).Value = "Prio 120 J" Then
                impact_120 = impact_120 + 1 '
                End If
                If .Cells(numLigne + 1, 10).Value = "En Fenêtre" Then
                impact_fen = impact_fen + 1 '
                End If
                If .Cells(numLigne + 1, 10).Value = "Autre" Then
                impact_autre = impact_autre + 1 '
                End If '
            End If '
 
            impact_total = impact_total + 1
 
        Else 'on est plus a la meme reference on peut mettre le compteur dans la case correspondante
           ' MsgBox "ref" & .Cells(numLigne, 1).Value & " à pour nombre d'impact : " & impact_total
            'mettre dans la col
            .Cells(numLigne, "M") = impact_total
            .Cells(numLigne, "N") = impact_40
            .Cells(numLigne, "O") = impact_120
            .Cells(numLigne, "P") = impact_fen
            .Cells(numLigne, "Q") = impact_autre
 
            'on compte l'impact de la prochaine ligne
            impact_total = 1
 
             If .Cells(numLigne + 1, 10).Value = "Prio 40 J" Then
             impact_40 = 1 '
             impact_120 = 0 '
            impact_fen = 0 '
            impact_autre = 0
            End If
 
            If .Cells(numLigne + 1, 10).Value = "Prio 120 J" Then
            impact_40 = 0 '
            impact_120 = 1 '
            impact_fen = 0 '
            impact_autre = 0
            End If
 
            If .Cells(numLigne + 1, 10).Value = "En Fenêtre" Then
            impact_40 = 0 '
            impact_120 = 0 '
            impact_fen = 1 '
            impact_autre = 0
            End If
 
            If .Cells(numLigne + 1, 10).Value = "Autre" Then
            impact_40 = 0 '
            impact_120 = 0 '
            impact_fen = 0 '
            impact_autre = 1
            End If
 
    End If
 
 
    Next numLigne
 
End With
 
'supprime les ligne redondante (meme reference), on garde la ligne où les impact ont été calculer precedement
Call supprSiImpactVide(onglet)
 
End Sub
 
Sub supprSiImpactVide(onglet)
'supprime les ligne redondante (meme reference), on garde la ligne où les impact ont été calculer precedement
  With Worksheets(onglet)
 
   macolonne = .Range("A1").End(xlToRight).Column
 
 
    For i = 1 To macolonne
        If Cells(1, i).Value = "impact Total " Then
            colImpact = i
           ' MsgBox colImpact
        End If
        If Cells(1, i).Value = "délai réactivité ou encours" Then
            colDelai = i
           ' MsgBox colDelai
        End If
    Next i
 
   som = .Cells(Rows.Count, "A").End(xlUp).Row
   'MsgBox som
         For num = 2 To som
            If IsEmpty(.Cells(num, colImpact)) = True Then 'si case est vide?
                'si on est a la fin alors on quite la boucle
                If IsEmpty(.Cells(num, 1)) = True Then
                   ' MsgBox num & "on est a la fin on quite la boucle"
                    Exit For
                End If
 
                ' delai
                    '.Cells(num + 1, colDelai) = .Cells(num, colDelai).Value
 
               ' MsgBox num & " la case impact total est vide : " & .Cells(num, colImpact).Value
 
                .Rows(num).Delete
                num = num - 1
            Else ' si la case nest pas vide il faut verifier la priorité et prendre la prio la plus importante (40,120..)
                Call ordrePrio(onglet)
 
            End If
         Next num
 
End With
 
End Sub
 
Sub MacroReunirPF()
'onglets PF MOA et métier IACT et ICDV mais avec un classement sur les priorites 40 puis 120 /Fenêtre/ Surveillance et délai décroissant.
'ajoute apres l'ongletAVANT
    onglet = "PF Total"
    ongletDep = "liste_total"
    Sheets(onglet).Delete
    Sheets.Add.Move After:=Sheets(ongletDep)
    numNewPF = (Worksheets(ongletDep).Index) + 1
    Sheets(numNewPF).Name = onglet
 
 
    ongletSelec = "PF MOA-PCTD"
    ' l'entete
    Worksheets(ongletSelec).Activate
    Range("A1:Q1").Select
    Selection.Copy
    Worksheets(onglet).Activate
    dernLig = Worksheets(onglet).Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1").Select
    ActiveSheet.Paste
 
    'pf moa pctd
    Call copiePF(ongletSelec, onglet)
 
    'pf moa pcte
    ongletSelec = "PF MOA-PCTE"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF MOA-PBCH"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF ICDV"
    Call copiePF(ongletSelec, onglet)
 
    ongletSelec = "PF IACT"
    Call copiePF(ongletSelec, onglet)
 
    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 Tri_Liste_Prio_delais2(onglet)
 
End Sub
 
Sub copiePF(ongletSelec, ongletCol)
'1838775 verif si surv copi il ne disparai pas car denierligne
    som = Worksheets(ongletSelec).Cells(Rows.Count, "A").End(xlUp).Row
    Worksheets(ongletSelec).Activate
    Range("A2:Q" & som).Select
    Selection.Copy
    Worksheets(ongletCol).Activate
    dernLig = Worksheets(ongletCol).Cells(Rows.Count, "A").End(xlUp).Row
    'MsgBox "on ajoute le contenu de " & ongletSelec & "à la derniere ligne : " & dernLig
    Range("A" & dernLig + 1).Select
    ActiveSheet.Paste
 
End Sub
 
'Function testSupprDoublons()
'Dim onglet
'onglet = "PF IACT"
'Call supprSiImpactVide(onglet)
'End Function
 
 
'Function figerLesPF()
  '  Dim onglet
  '  instance = Array("PF IACT", "PF ICDV", "PF MOA-PCTD", "PF MOA-PCTE", "PF MOA-PBCH")
 
   ' For m = LBound(instance) To UBound(instance)
   '     onglet = instance(m)
    '    ActiveWorkbook.Worksheets(onglet).Activate
   '     Range("C1").Select
     '   ActiveWindow.FreezePanes = True
   ' Next m
 
'End Function
 
 
'Function figertest()
 'Dim onglet
   ' instance = Array("PF IACT", "PF ICDV", "PF MOA-PCTD", "PF MOA-PCTE", "PF MOA-PBCH")
 
    'For m = LBound(instance) To UBound(instance)
    '    onglet = instance(m)
    '    ActiveWorkbook.Worksheets(onglet).Activate
    '    Range("C1").Select
     '   ActiveWindow.FreezePanes = True
 
   ' Next m
 
'End Function
 
Sub ordrePrio(onglet)
' si la case nest pas vide il faut verifier la priorité et prendre la prio la plus importante (40,120..)
' car on a garder que une ligne pour chaque reference et on veut voir directement la priorité la plus importante
With Worksheets(onglet)
 
   macolonne = .Range("A1").End(xlToRight).Column
 
 
    For i = 1 To macolonne
        If Cells(1, i).Value = "impact Total " Then
            colImpact = i
           ' MsgBox colImpact
        End If
 
        If Cells(1, i).Value = "impact 40 " Then
            colImpact40 = i
           ' MsgBox colImpact
        End If
 
        If Cells(1, i).Value = "impact 120 " Then
            colImpact120 = i
           ' MsgBox colImpact
        End If
 
        If Cells(1, i).Value = "impact fen " Then
            colImpactFen = i
           ' MsgBox colImpact
        End If
 
        If Cells(1, i).Value = "impact autre " Then
            colImpactAu = i
           ' MsgBox colImpact
        End If
 
        If Cells(1, i).Value = "Priorite_Impact_FT" Then
            colPrio = i
           ' MsgBox colImpact
        End If
 
    Next i
 
 
    som = .Cells(Rows.Count, "A").End(xlUp).Row
   'MsgBox som
    For num = 2 To som
        If .Cells(num, colImpact40) > 0 Then
            .Cells(num, colPrio) = "Prio 40 J"
        Else
            If .Cells(num, colImpact120) > 0 Then
                .Cells(num, colPrio) = "Prio 120 J"
            Else
                If .Cells(num, colImpactFen) > 0 Then
                    .Cells(num, colPrio) = "En Fenêtre"
                Else
                    .Cells(num, colPrio) = "Autre"
                End If
 
            End If
 
        End If
 
    Next num
 
End With
 
End Sub

Cordialement

Création de ligne rentrée en dur.A faire en auto

Macros et VBA Excel

Discussions similaires

Partager

Partager