Discussion :

[naozumi8]

Bonjour à tous,

J'ai un souci au lancement de mon code, cela m'indique : Variable objet ou variable de bloc with non définie
Cela semble lié a la ligne :



J'avoue ne pas en comprendre la raison et que faire, si vous pouviez m'aider ?
Merci d'avance à vous

[jurassic pork]

Hello,
essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each numCell In ws.Range("A2:A" & CStr(lastRowGlobal))

ou alors

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim numCell

sans préciser as Range

Ami calmant, J.P

[naozumi8]

Hello,
essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each numCell In ws.Range("A2:A" & CStr(lastRowGlobal))

ou alors

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim numCell

sans préciser as Range

Ami calmant, J.P

Malheureusement cela ne change rien peu importe la solution

[mach1974]

Bonjour,
Il faut ajouter Set ws = nom de la feuille car ws n'est pas identifié

[naozumi8]

Bonjour,
Il faut ajouter Set ws = nom de la feuille car ws n'est pas identifié

C'est pourtant le cas :

Set ws = ThisWorkbook.Sheets("Global")

[Valtrase]

Salut,
Quelques réflexions :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ActiveSheet.Name = "Global"

Ceci peu amener à des résultats inattendus. Si tu a créé un feuille en amont nommes-la lors de la création.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells.Select

Idem pour cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If ActiveCell.Row <> lastRow Then

Ici tu déclares lastRow au niveau de la procédure et tu ne l'a pas affecter il est donc toujours égal à 0, l'utilisation de Activecell peut aussi provoquer des résultats inattendus.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set ws = ThisWorkbook.Sheets("Global")

Ici tu affecte la variable ws c'est bien , mais plus bas tu utilises

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells.Select

Là encore des résultats inattendus peuvent arrivés préfère lui

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ws.Cells.Select

Et encore mieux null besoin de faire des Select.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Columns("B:B").ColumnWidth = 6#

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    Dim sheetOld As Worksheet
    On Error Resume Next
    Set sheetOld = ThisWorkbook.Sheets("OLD")
    On Error GoTo 0

Ce n'est pas une bonne habitude que d'utiliser On Error pour ce type de contrôle, plus haut tu as fait une boucle tu peux refaire la boucle pour vérifier sa présence ou mieu te créer une fonction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set wsGlobal = ThisWorkbook.Sheets("Global")

Ici tu affectes une variable wsGlobal à la feuille "Global" alors que ws fait déjà référence à cette feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

lastRowGlobal = wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row

Puisque la feuille Global contient un tableau structuré utilises les outils adaptés aux tableaux structurés

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
    Dim MonTableau As ListObject    Set MonTableau = ThisWorkbook.Worksheets.Item("Global").ListObject
    With MonTableau
        Debug.Print .ListRows.Count        'Nombre de lignes
 
        Dim IDCell As Range
        For Each IDCell In .ListColumns.Item("ID").DataBodyRange        'boucle sur les cellules de la colonne "ID"
            Debug.Print IDCell.Value
        Next IDCell
 
        Dim NewRow As ListRow
        Set NewRow = .Add        'Ajoute une ligne à la fin
        With NewRow
            .Range(MonTableau.ListColumns("Total").Index).Value = 100        'Utilisation du nom de la colonne plus explicite que Range("B" & LastRow)par exemple
        End With
    End With

Bon et là je ne vais pas plus loin car j'ai du wsGlobal, ws, wsOld

Pour ton erreur je pense que tu dois faire un nettoyage au niveau de tes affectations. ws, wsGlobal et wsOld et supprimer celles qui ne sont plus nécessaires. en les passant à Nothing.

[Franc]

Bonjour, je vois que tu utilises plusieurs fois l'instruction Set mais les variables n'ont pas été déclarées auparavant, par exemple Set commentairesRangeGlobal...
Tu devrais activer Option Explicit, ça t'évitera pas mal d'erreurs par la suite.
Je constate aussi que tu affectes la même feuille à 2 variables:

Set ws = ThisWorkbook.Sheets("Global") et Set wsGlobal = ThisWorkbook.Sheets("Global")

[Valtrase]

Re,
Je vois que tu boucles sur ws

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    For Each ws In ThisWorkbook.Sheets        If ws.Name <> "OLD" Then ' Exclure la feuille "OLD"
            SurlignerEnAttente ws
        End If
    Next ws

Sait-tu sur quelle feuille s'est arrêtée la boucle ?
ensuite tu essais de faire une autre boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each numCell In ws.Range("A2:A" & lastRowGlobal)

Mais tu n'est peut-être pas sur la bonne feuille... Il te faut un peu plus de rigueur dans ta programmation.

[naozumi8]

Ok, après analyse, si je résous une erreur, cela en génère d'autre, j'ai donc 2 possibilités : réparer chaque erreur apparaissant, ou intégrer différemment

Mon code suivant fonctionne bien :


Du coup au lieu d'appeler cette macro, est il possible de l'intégrer a mon code existant ?
en sachant que je voudrais que cette colorisation s'effectue après les autres vu que je la veux dominante

[Valtrase]

Re,
Il est toujours meilleur de créer de petites fonctions cela rends le code plus facile à lire. Et c'est valable pour ton cas.
Il ne faut pas mélanger torchons et chemises, si tu références ws en tant que Worksheet boucle sur toutes les Worksheets et non pas Sheets c'est plus lisible.

Bon tu regardes ce qu'il se passe pour ce faire dans la partie de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    ' Appeler la nouvelle fonction SurlignerEnAttente pour chaque feuille    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "OLD" Then ' Exclure la feuille "OLD"
            SurlignerEnAttente ws
        End If
    Next ws

Mets un point d'arret sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

SurlignerEnAttente ws

Ensuite sélectionne ws et ajoute un espion MAJ + F9
Après lance la procédure et regarde à quoi correspond ws

[naozumi8]

Re,
Il est toujours meilleur de créer de petites fonctions cela rends le code plus facile à lire. Et c'est valable pour ton cas.
Il ne faut pas mélanger torchons et chemises, si tu références ws en tant que Worksheet boucle sur toutes les Worksheets et non pas Sheets c'est plus lisible.

Bon tu regardes ce qu'il se passe pour ce faire dans la partie de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    ' Appeler la nouvelle fonction SurlignerEnAttente pour chaque feuille    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "OLD" Then ' Exclure la feuille "OLD"
            SurlignerEnAttente ws
        End If
    Next ws

Mets un point d'arret sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

SurlignerEnAttente ws

Ensuite sélectionne ws et ajoute un espion MAJ + F9
Après lance la procédure et regarde à quoi correspond ws

Il semblerait que de cette facon, cela passe correctement :

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
 
Sub ComparerEtCopierDescriptif()
    Dim wsGlobal As Worksheet
    Dim wsOld As Worksheet
    Dim lastRowGlobal As Long
    Dim lastRowOld As Long
    Dim numRowGlobal As Range
    Dim numRowOld As Range
    Dim DescriptifRangeOld As Range
    Dim DescriptifCell As Range
    Dim matchCell As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim ws As Worksheet
    Dim numCell As Range
    Dim couleurCell As Range
 
' Renommer la feuille active en "Global"
ActiveSheet.Name = "Global"
 
' AnnulationRetourLigneAuto Macro
'
 
'
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
 
    ' Remplacez "Global" par le nom de la feuille de calcul qui contient les données exportées
    Set ws = ThisWorkbook.Sheets("Global")
 
    ' Applique un style bleu clair comme tableau
    If ActiveCell.Row <> lastRow Then
            ws.ListObjects.Add(xlSrcRange, ws.UsedRange, , xlYes).TableStyle = "TableStyleLight13"
    End If
 
      ' LargeurColonne Macro
'
 
'
    Cells.Select
    Cells.EntireColumn.AutoFit
	Columns("B:B").Select
    Selection.ColumnWidth = 6#
	Columns("C:C").Select
    Selection.ColumnWidth = 10#
	Columns("D:D").Select
    Selection.ColumnWidth = 16#
    Columns("H:H").Select
    Selection.ColumnWidth = 57#
	Columns("J:J").Select
    Selection.ColumnWidth = 9#
	Columns("K:K").Select
    Selection.ColumnWidth = 16#
 
' Définir la valeur de la cellule I1 sur "Délai de résolution"
    ActiveSheet.Range("I1").Select
        ActiveCell.Value = Replace(ActiveCell.Value, "Date d'échéance", "Délai de résolution")
 
' Définir la valeur de la cellule M1 sur "Commentaires"
    ActiveSheet.Range("M1").Select
        ActiveCell.Value = Replace(ActiveCell.Value, "En attente de", "Commentaires")
 
 
 
 
   ' Vérifier la présence de la feuille "OLD"
    Dim sheetOld As Worksheet
    On Error Resume Next
    Set sheetOld = ThisWorkbook.Sheets("OLD")
    On Error GoTo 0
 
 
 
        ' Remplacez "Global" et "OLD" par les noms de vos feuilles de calcul
    Set wsGlobal = ThisWorkbook.Sheets("Global")
    Set wsOld = ThisWorkbook.Sheets("OLD")
 
    ' Trouver la dernière ligne avec des données dans la colonne "Numéro" de la feuille "Global"
    lastRowGlobal = wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row
 
    ' Trouver la dernière ligne avec des données dans la colonne "Numéro" de la feuille "OLD"
    lastRowOld = wsOld.Cells(wsOld.Rows.Count, "A").End(xlUp).Row
 
    ' Définir la plage de données dans les colonnes "Numéro" et "Commentaires" de la feuille "Global"
    Set numRowGlobal = wsGlobal.Range("A2:A" & lastRowGlobal)
    Set commentairesRangeGlobal = wsGlobal.Range("M2:M" & lastRowGlobal)
 
    ' Définir la plage de données dans les colonnes "Numéro" et "Commentaires" de la feuille "OLD"
    Set numRowOld = wsOld.Range("A2:A" & lastRowOld)
    Set commentairesRangeOld = wsOld.Range("M2:M" & lastRowOld)
 
    ' Date limite : aujourd'hui moins 7 jours
    dateLimite = Date - 7
    ' Parcourir chaque cellule de la colonne "Numéro" de la feuille "Global"
    For Each numCell In ws.Range("A2:A" & lastRowGlobal)
        ' Recherche de la correspondance dans la feuille "OLD"
        Set matchCell = wsOld.Range("A2:A" & lastRowOld).Find(numCell.Value, LookIn:=xlValues)
 
        ' Si une correspondance est trouvée
        If Not matchCell Is Nothing Then
            ' Vérifier si la date est aujourd'hui ou dans les 7 jours précédents
            If IsDate(ws.Cells(numCell.Row, "G").Value) Then
                If DateValue(ws.Cells(numCell.Row, "G").Value) >= dateLimite And DateValue(ws.Cells(numCell.Row, "G").Value) <= Date Then
                    ' Si vérifié récent et présent dans OLD, colorier la ligne en rouge
                    ws.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(255, 0, 0) ' Rouge
                    ' Copier les commentaires de la feuille "OLD" vers la feuille "Global"
            Set commentairesCell = commentairesRangeOld.Cells(matchCell.Row - commentairesRangeOld.Row + 1)
            numCell.Offset(0, 12).Value = commentairesCell.Value ' Copier dans la colonne "Commentaires" de la feuille "Global"
                Else
                    ' Si non vérifié récent et présent dans OLD, colorier la ligne en orange
                    ws.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(255, 192, 0) ' Orange
                    ' Copier les commentaires de la feuille "OLD" vers la feuille "Global"
            Set commentairesCell = commentairesRangeOld.Cells(matchCell.Row - commentairesRangeOld.Row + 1)
            numCell.Offset(0, 12).Value = commentairesCell.Value ' Copier dans la colonne "Commentaires" de la feuille "Global"
                End If
            End If
        Else
            ' Si non vérifié récent (colonne D) et non présent dans OLD, colorier la ligne en rose
            If IsDate(ws.Cells(numCell.Row, "G").Value) Then
                If DateValue(ws.Cells(numCell.Row, "G").Value) >= dateLimite And DateValue(ws.Cells(numCell.Row, "G").Value) <= Date Then
                    ws.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(248, 203, 173) ' Rose
                End If
            End If
        End If
    Next numCell
 
    Application.ScreenUpdating = False ' Désactiver la mise à jour de l'écran pour accélérer le processus
 
    ' Créer un dictionnaire pour stocker les groupes uniques
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
 
    ' Activer la première cellule de la colonne contenant les groupes d'affectation (colonne L)
    Set ws = ThisWorkbook.Sheets("Global")
    ws.Activate
    ws.Range("L2").Select
 
 
    ' Boucle à travers chaque cellule dans la colonne des groupes d'affectation
    Do Until IsEmpty(ActiveCell)
        ' Obtenir le nom du groupes d'affectation
        groupe = ActiveCell.Value
 
 
 
    ' Si le groupes d'affectation n'est pas déjà dans le dictionnaire, le stocker
        If Not dict.Exists(groupe) Then
            dict.Add groupe, 0
        End If
 
        ' Aller à la prochaine cellule dans la colonne des groupes
        ActiveCell.Offset(1, 0).Select
    Loop
 
    ' Boucle à travers les groupes stockés dans le dictionnaire
    For Each groupe In dict.Keys
        ' Créer une nouvelle feuille de calcul avec le nom du groupe
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = groupe
        Set newWs = ThisWorkbook.Sheets(groupe)
 
        ' Copier la ligne d'en-tête depuis la feuille "Global"
        ws.Rows(1).Copy Destination:=newWs.Rows(1)
 
        ' Réinitialiser la variable lastRow
        lastRow = 0
 
        ' Activer la première cellule de la colonne contenant les groupes (colonne L)
        ws.Activate
        ws.Range("L2").Select
 
        ' Boucle à travers chaque cellule dans la colonne des groupes
        Do Until IsEmpty(ActiveCell)
            ' Obtenir le nom du groupe
            If ActiveCell.Value = groupe Then
                ' Vérifier si la ligne n'a pas déjà été copiée
                If ActiveCell.Row <> lastRow Then
                    ' Copier la ligne de données dans la feuille de calcul du groupe
                    ws.Rows(ActiveCell.Row).Copy Destination:=newWs.Cells(newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1, 1)
                    ' Mettre à jour la variable lastRow
                    lastRow = ActiveCell.Row
                End If
            End If
 
            ' Aller à la prochaine cellule dans la colonne des groupes
            ActiveCell.Offset(1, 0).Select
        Loop
 
' Appliquer le style au tableau sur la feuille en cours
        newWs.ListObjects.Add(xlSrcRange, newWs.UsedRange, , xlYes).TableStyle = "TableStyleLight13"
 
' LargeurColonne Macro pour chaque feuille
'
 
'
   newWs.Cells.EntireColumn.AutoFit
     newWs.Columns("B:B").ColumnWidth = 6#
	 newWs.Columns("C:C").ColumnWidth = 10#
	 newWs.Columns("D:D").ColumnWidth = 16#
	 newWs.Columns("H:H").ColumnWidth = 57#
     newWs.Columns("J:J").ColumnWidth = 9#
	 newWs.Columns("K:K").ColumnWidth = 16#
 
    Next groupe
 
   ' Ajouter le tableau des couleurs en bas de chaque feuille
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "OLD" Then ' Ne pas appliquer sur la feuille "OLD"
            ' Trouver la première cellule vide 5 lignes en dessous du tableau
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            Set couleurCell = ws.Cells(lastRow + 5, 5)
 
            ' Déja vus
            couleurCell.Interior.Color = RGB(255, 192, 0) ' Orange
            couleurCell.Offset(0, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(0, 1).Value = "Déjà vus"
            couleurCell.Offset(0, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' En cours
            couleurCell.Offset(1, 0).Interior.Color = RGB(248, 203, 173) ' Rose
            couleurCell.Offset(1, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(1, 1).Value = "En cours"
            couleurCell.Offset(1, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' En attente de MEP
            couleurCell.Offset(2, 0).Interior.Color = RGB(180, 198, 231) ' Bleu clair
            couleurCell.Offset(2, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(2, 1).Value = "En attente de MEP"
            couleurCell.Offset(2, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' Clos
            couleurCell.Offset(3, 0).Interior.Color = RGB(169, 208, 142) ' Vert clair
            couleurCell.Offset(3, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(3, 1).Value = "Clos"
            couleurCell.Offset(3, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
 SurlignerEnAttente ws
 
        End If
    Next ws
 
   '  Supprimer la feuille "OLD" à la fin
  ThisWorkbook.Sheets("OLD").Delete ' Supprimer la feuille "OLD"
 
  ' Si la feuille "OLD" n'existe pas, afficher un message et quitter la macro
    If sheetOld Is Nothing Then
        MsgBox "La feuille 'OLD' n'a pas été trouvée. Veuillez vérifier votre fichier.", vbExclamation
        Exit Sub
    End If
 
    Application.ScreenUpdating = True ' Réactiver la mise à jour de l'écran
End Sub
 
Sub SurlignerEnAttente(ws As Worksheet)
    Dim rng As Range
    Dim cell As Range
 
    ' Spécifiez la plage de données, ajustez selon vos besoins
    Set rng = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
 
    ' Parcours chaque cellule de la colonne "Ref" depuis la deuxième ligne
    For Each cell In rng
        ' Vérifie si "Ref" n'est pas vide et "Statut" est "En attente"
        If cell.Offset(0, 9).Value <> "" And cell.Offset(0, 4).Value = "En attente" Then
            ' Surligne la ligne en RGB(180,198,231)
            cell.Resize(, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column).Interior.Color = RGB(180, 198, 231)
        End If
    Next cell
End Sub

Mais si vous avez des idées d'améliorations ?
J'avoue que je suis pas développeur (j'ai vite fait des bases), je comprends a peu prêt ce que je fait et je m'aide pas mal de ChatGPT, mais le but est de m'améliorer la dedans quand même

[Franc]

Mais si vous avez des idées d'améliorations ?
J'avoue que je suis pas développeur (j'ai vite fait des bases), je comprends a peu prêt ce que je fait et je m'aide pas mal de ChatGPT, mais le but est de m'améliorer la dedans quand même

Des idées d'amélioration on t'en a déjà donné, mais apparemment tu n'en tiens pas compte.
Je t'ai signalé des instruction Set sans les déclarations Dim.
Tu déclares 2 fois Dim sheetOld As Worksheet
ActiveSheet.Name = "Global" est risqué, quelle que soit la feuille où tu te trouves au lancement de la macro ta feuille sera renommée et si elle existe déjà, le code s'arrêtera sur erreur puisque tu ne gères pas cette possibilité.
Je t'ai suggéré de placer Option Explicit en début de module pour éviter certaines erreurs mais...tu ne le fais pas.
Et tu dis que tu veux t'améliorer ???

[naozumi8]

Des idées d'amélioration on t'en a déjà donné, mais apparemment tu n'en tiens pas compte.
Je t'ai signalé des instruction Set sans les déclarations Dim.
Tu déclares 2 fois Dim sheetOld As Worksheet
ActiveSheet.Name = "Global" est risqué, quelle que soit la feuille où tu te trouves au lancement de la macro ta feuille sera renommée et si elle existe déjà, le code s'arrêtera sur erreur puisque tu ne gères pas cette possibilité.
Je t'ai suggéré de placer Option Explicit en début de module pour éviter certaines erreurs mais...tu ne le fais pas.
Et tu dis que tu veux t'améliorer ???

Doucement Franc, on se calme

Alors, oui j'avais commencé a déclaré mais n'avais pas finis effectivement
rien ne sert de s'énerver

du coup j'ai essayé de l'améliorer un peu

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
Option Explicit
 
Sub ComparerEtCopierDescriptif()
    Dim wsGlobal As Worksheet
    Dim wsOld As Worksheet
    Dim lastRowGlobal As Long
    Dim lastRowOld As Long
    Dim numRowGlobal As Range
    Dim numRowOld As Range
    Dim DescriptifRangeOld As Range
    Dim DescriptifCell As Range
    Dim matchCell As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim ws As Worksheet
    Dim numCell As Range
    Dim couleurCell As Range
	Dim commentairesRangeOld As Range
	Dim dateLimite As Date
	Dim commentairesCell As Range
	Dim groupe As Variant
	Dim newWs As Worksheet
 
'Renomme la feuille 1 et l'active
Worksheets(1).Name = "Global"
Worksheets(1).Activate 
 
 
' AnnulationRetourLigneAuto Macro
'
 
' Remplacez "Global" par le nom de la feuille de calcul qui contient les données exportées
    Set ws = ThisWorkbook.Worksheets("Global")
 
   With ws.UsedRange
    ' Formatez la première partie de la plage
    .HorizontalAlignment = xlGeneral
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
 
    ' Formatez la deuxième partie de la plage
    With .Cells
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End With
 
 
 
 
    ' Applique un style bleu clair comme tableau
    If ActiveCell.Row <> lastRow Then
            ws.ListObjects.Add(xlSrcRange, ws.UsedRange, , xlYes).TableStyle = "TableStyleLight13"
    End If
 
      ' AutoFit pour l'ensemble des colonnes
    ws.UsedRange.EntireColumn.AutoFit
 
    ' Ajustez les largeurs de colonne directement
	' B : Service
    ws.Columns("B:B").ColumnWidth = 6# 
	'C : Environnement
    ws.Columns("C:C").ColumnWidth = 10#
	'D : Appelant
    ws.Columns("D:D").ColumnWidth = 16#
	'H : Description courte
    ws.Columns("H:H").ColumnWidth = 57#
	'J : Ref
    ws.Columns("J:J").ColumnWidth = 9#
	'K : Affecté à
    ws.Columns("K:K").ColumnWidth = 16#
 
' Définir la valeur de la cellule I1 sur "Délai de résolution"
    ActiveSheet.Range("I1").Select
        ActiveCell.Value = Replace(ActiveCell.Value, "Date d'échéance", "Délai de résolution")
 
' Définir la valeur de la cellule M1 sur "Commentaires"
    ActiveSheet.Range("M1").Select
        ActiveCell.Value = Replace(ActiveCell.Value, "En attente de", "Commentaires")
 
 
 
 
   ' Vérifier la présence de la feuille "OLD"
 
    On Error Resume Next
    Set wsOld = ThisWorkbook.worksheets("OLD")
    On Error GoTo 0
 
 
 
        ' Remplacez "Global" et "OLD" par les noms de vos feuilles de calcul
    Set wsGlobal = ThisWorkbook.worksheets("Global")
 
 
    ' Trouver la dernière ligne avec des données dans la colonne "Numéro" de la feuille "Global"
    lastRowGlobal = wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row
 
    ' Trouver la dernière ligne avec des données dans la colonne "Numéro" de la feuille "OLD"
    lastRowOld = wsOld.Cells(wsOld.Rows.Count, "A").End(xlUp).Row
 
    ' Définir la plage de données dans les colonnes "Numéro" et "Commentaires" de la feuille "Global"
    Set numRowGlobal = wsGlobal.Range("A2:A" & lastRowGlobal)
 
 
    ' Définir la plage de données dans les colonnes "Numéro" et "Commentaires" de la feuille "OLD"
    Set numRowOld = wsOld.Range("A2:A" & lastRowOld)
    Set commentairesRangeOld = wsOld.Range("M2:M" & lastRowOld)
 
    ' Date limite : aujourd'hui moins 7 jours
    dateLimite = Date - 7
    ' Parcourir chaque cellule de la colonne "Numéro" de la feuille "Global"
    For Each numCell In ws.Range("A2:A" & lastRowGlobal)
        ' Recherche de la correspondance dans la feuille "OLD"
        Set matchCell = wsOld.Range("A2:A" & lastRowOld).Find(numCell.Value, LookIn:=xlValues)
 
        ' Si une correspondance est trouvée
        If Not matchCell Is Nothing Then
            ' Vérifier si la date est aujourd'hui ou dans les 7 jours précédents
            If IsDate(ws.Cells(numCell.Row, "G").Value) Then
                If DateValue(ws.Cells(numCell.Row, "G").Value) >= dateLimite And DateValue(ws.Cells(numCell.Row, "G").Value) <= Date Then
                    ' Si vérifié récent et présent dans OLD, colorier la ligne en rouge
                    ws.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(255, 0, 0) ' Rouge
                    ' Copier les commentaires de la feuille "OLD" vers la feuille "Global"
            Set commentairesCell = commentairesRangeOld.Cells(matchCell.Row - commentairesRangeOld.Row + 1)
            numCell.Offset(0, 12).Value = commentairesCell.Value ' Copier dans la colonne "Commentaires" de la feuille "Global"
                Else
                    ' Si non vérifié récent et présent dans OLD, colorier la ligne en orange
                    ws.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(255, 192, 0) ' Orange
                    ' Copier les commentaires de la feuille "OLD" vers la feuille "Global"
            Set commentairesCell = commentairesRangeOld.Cells(matchCell.Row - commentairesRangeOld.Row + 1)
            numCell.Offset(0, 12).Value = commentairesCell.Value ' Copier dans la colonne "Commentaires" de la feuille "Global"
                End If
            End If
        Else
            ' Si non vérifié récent (colonne D) et non présent dans OLD, colorier la ligne en rose
            If IsDate(ws.Cells(numCell.Row, "G").Value) Then
                If DateValue(ws.Cells(numCell.Row, "G").Value) >= dateLimite And DateValue(ws.Cells(numCell.Row, "G").Value) <= Date Then
                    ws.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(248, 203, 173) ' Rose
                End If
            End If
        End If
    Next numCell
 
    Application.ScreenUpdating = False ' Désactiver la mise à jour de l'écran pour accélérer le processus
 
    ' Créer un dictionnaire pour stocker les groupes uniques
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
 
    ' Activer la première cellule de la colonne contenant les groupes d'affectation (colonne L)
    Set ws = ThisWorkbook.worksheets("Global")
    ws.Activate
    ws.Range("L2").Select
 
 
    ' Boucle à travers chaque cellule dans la colonne des groupes d'affectation
    Do Until IsEmpty(ActiveCell)
        ' Obtenir le nom du groupes d'affectation
        groupe = ActiveCell.Value
 
 
 
    ' Si le groupes d'affectation n'est pas déjà dans le dictionnaire, le stocker
        If Not dict.Exists(groupe) Then
            dict.Add groupe, 0
        End If
 
        ' Aller à la prochaine cellule dans la colonne des groupes
        ActiveCell.Offset(1, 0).Select
    Loop
 
    ' Boucle à travers les groupes stockés dans le dictionnaire
    For Each groupe In dict.Keys
        ' Créer une nouvelle feuille de calcul avec le nom du groupe
        ThisWorkbook.worksheets.Add(After:=ThisWorkbook.worksheets(ThisWorkbook.worksheets.Count)).Name = groupe
        Set newWs = ThisWorkbook.worksheets(groupe)
 
        ' Copier la ligne d'en-tête depuis la feuille "Global"
        ws.Rows(1).Copy Destination:=newWs.Rows(1)
 
        ' Réinitialiser la variable lastRow
        lastRow = 0
 
        ' Activer la première cellule de la colonne contenant les groupes (colonne L)
        ws.Activate
        ws.Range("L2").Select
 
        ' Boucle à travers chaque cellule dans la colonne des groupes
        Do Until IsEmpty(ActiveCell)
            ' Obtenir le nom du groupe
            If ActiveCell.Value = groupe Then
                ' Vérifier si la ligne n'a pas déjà été copiée
                If ActiveCell.Row <> lastRow Then
                    ' Copier la ligne de données dans la feuille de calcul du groupe
                    ws.Rows(ActiveCell.Row).Copy Destination:=newWs.Cells(newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1, 1)
                    ' Mettre à jour la variable lastRow
                    lastRow = ActiveCell.Row
                End If
            End If
 
            ' Aller à la prochaine cellule dans la colonne des groupes
            ActiveCell.Offset(1, 0).Select
        Loop
 
' Appliquer le style au tableau sur la feuille en cours
        newWs.ListObjects.Add(xlSrcRange, newWs.UsedRange, , xlYes).TableStyle = "TableStyleLight13"
 
' LargeurColonne Macro pour chaque feuille
'
 
'
   newWs.Cells.EntireColumn.AutoFit
     newWs.Columns("B:B").ColumnWidth = 6#
	 newWs.Columns("C:C").ColumnWidth = 10#
	 newWs.Columns("D:D").ColumnWidth = 16#
	 newWs.Columns("H:H").ColumnWidth = 57#
     newWs.Columns("J:J").ColumnWidth = 9#
	 newWs.Columns("K:K").ColumnWidth = 16#
 
    Next groupe
 
   ' Ajouter le tableau des couleurs en bas de chaque feuille
    For Each ws In ThisWorkbook.worksheets
        If ws.Name <> "OLD" Then ' Ne pas appliquer sur la feuille "OLD"
            ' Trouver la première cellule vide 5 lignes en dessous du tableau
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            Set couleurCell = ws.Cells(lastRow + 5, 5)
 
            ' Déja vus
            couleurCell.Interior.Color = RGB(255, 192, 0) ' Orange
            couleurCell.Offset(0, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(0, 1).Value = "Déjà vus"
            couleurCell.Offset(0, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' En cours
            couleurCell.Offset(1, 0).Interior.Color = RGB(248, 203, 173) ' Rose
            couleurCell.Offset(1, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(1, 1).Value = "En cours"
            couleurCell.Offset(1, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' En attente de MEP
            couleurCell.Offset(2, 0).Interior.Color = RGB(180, 198, 231) ' Bleu clair
            couleurCell.Offset(2, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(2, 1).Value = "En attente de MEP"
            couleurCell.Offset(2, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' Clos
            couleurCell.Offset(3, 0).Interior.Color = RGB(169, 208, 142) ' Vert clair
            couleurCell.Offset(3, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(3, 1).Value = "Clos"
            couleurCell.Offset(3, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
 SurlignerEnAttente ws
 
        End If
    Next ws
 
   '  Supprimer la feuille "OLD" à la fin
  ThisWorkbook.worksheets("OLD").Delete ' Supprimer la feuille "OLD"
 
  ' Si la feuille "OLD" n'existe pas, afficher un message et quitter la macro
    If wsOld Is Nothing Then
        MsgBox "La feuille 'OLD' n'a pas été trouvée. Veuillez vérifier votre fichier.", vbExclamation
        Exit Sub
    End If
 
    Application.ScreenUpdating = True ' Réactiver la mise à jour de l'écran
End Sub
 
'Script by XXX
 
Sub SurlignerEnAttente(ws As Worksheet)
    Dim rng As Range
    Dim cell As Range
 
    ' Spécifiez la plage de données, ajustez selon vos besoins
    Set rng = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
 
    ' Parcours chaque cellule de la colonne "Ref" depuis la deuxième ligne
    For Each cell In rng
        ' Vérifie si "Ref" n'est pas vide et "Statut" est "En attente"
        If cell.Offset(0, 9).Value <> "" And cell.Offset(0, 4).Value = "En attente" Then
            ' Surligne la ligne en RGB(180,198,231)
            cell.Resize(, ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column).Interior.Color = RGB(180, 198, 231)
        End If
    Next cell
End Sub

Il y a surement des choses que je n'ai pas pris en compte, c'est possible, si c'est le cas, c'est que je n'ai pas les connaissance actuelles pour le faire, mais toute aide est la bienvenue
Et encore merci

[Franc]

Il n'y a pas d'énervement, simplement de la constatation. Voici un moyen simple d'éviter certaines erreurs:
Va dans les options de l'éditeur VBA et coche la case "Déclaration des variables obligatoire", Option Explicit sera inséré automatiquement.

[naozumi8]

Autant pour moi alors,

J'en suis rendu en essayant de prendre en compte vos commentaires cela donnerais :
y a t'il d'autre choses possible ?

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
 
Sub ComparerEtCopierDescriptif()
    Dim wsGlobal As Worksheet
    Dim wsOld As Worksheet
    Dim lastRowGlobal As Long
    Dim lastRowOld As Long
    Dim numRowGlobal As Range
    Dim numRowOld As Range
    Dim DescriptifRangeOld As Range
    Dim DescriptifCell As Range
    Dim matchCell As Range
    Dim lastRow As Long
    Dim cell As Range
    Dim numCell As Range
    Dim couleurCell As Range
    Dim commentairesRangeOld As Range
    Dim dateLimite As Date
    Dim commentairesCell As Range
    Dim groupe As Variant
    Dim newWs As Worksheet
 
'Renomme la feuille 1 et l'active
Worksheets(1).Name = "Global"
Worksheets(1).Activate 
 
 
' AnnulationRetourLigneAuto Macro
'
 
' Remplacez "Global" par le nom de la feuille de calcul qui contient les données exportées
    Set wsGlobal = ThisWorkbook.Worksheets("Global")
 
   With wsGlobal.UsedRange
    ' Formatez la première partie de la plage
    .HorizontalAlignment = xlGeneral
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
 
    ' Formatez la deuxième partie de la plage
    With .Cells
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End With
 
 
 
 
    ' Applique un style bleu clair comme tableau
    If ActiveCell.Row <> lastRow Then
            wsGlobal.ListObjects.Add(xlSrcRange, wsGlobal.UsedRange, , xlYes).TableStyle = "TableStyleLight13"
    End If
 
      ' AutoFit pour l'ensemble des colonnes
    wsGlobal.UsedRange.EntireColumn.AutoFit
 
    ' Ajustez les largeurs de colonne directement
	' B : Service
    wsGlobal.Columns("B:B").ColumnWidth = 6# 
	'C : Environnement
    wsGlobal.Columns("C:C").ColumnWidth = 10#
	'D : Appelant
    wsGlobal.Columns("D:D").ColumnWidth = 16#
	'H : Description courte
    wsGlobal.Columns("H:H").ColumnWidth = 57#
	'J : Ref
    wsGlobal.Columns("J:J").ColumnWidth = 9#
	'K : Affecté à
    wsGlobal.Columns("K:K").ColumnWidth = 16#
 
' Définir la valeur de la cellule I1 sur "Délai de résolution"
    wsGlobal.Range("I1").Value = Replace(wsGlobal.Range("I1").Value, "Date d'échéance", "Délai de résolution")
 
 
' Définir la valeur de la cellule M1 sur "Commentaires"
   wsGlobal.Range("M1").Value = Replace(wsGlobal.Range("M1").Value, "En attente de", "Commentaires")
 
 
   ' Vérifier la présence de la feuille "OLD"
 
    On Error Resume Next
    Set wsOld = ThisWorkbook.worksheets("OLD")
    On Error GoTo 0
 
 
 
    ' Trouver la dernière ligne avec des données dans la colonne "Numéro" de la feuille "Global"
    lastRowGlobal = wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row
 
    ' Trouver la dernière ligne avec des données dans la colonne "Numéro" de la feuille "OLD"
    lastRowOld = wsOld.Cells(wsOld.Rows.Count, "A").End(xlUp).Row
 
    ' Définir la plage de données dans les colonnes "Numéro" et "Commentaires" de la feuille "Global"
    Set numRowGlobal = wsGlobal.Range("A2:A" & lastRowGlobal)
 
 
    ' Définir la plage de données dans les colonnes "Numéro" et "Commentaires" de la feuille "OLD"
    Set numRowOld = wsOld.Range("A2:A" & lastRowOld)
    Set commentairesRangeOld = wsOld.Range("M2:M" & lastRowOld)
 
    ' Date limite : aujourd'hui moins 7 jours
    dateLimite = Date - 7
    ' Parcourir chaque cellule de la colonne "Numéro" de la feuille "Global"
    For Each numCell In wsGlobal.Range("A2:A" & lastRowGlobal)
        ' Recherche de la correspondance dans la feuille "OLD"
        Set matchCell = wsOld.Range("A2:A" & lastRowOld).Find(numCell.Value, LookIn:=xlValues)
 
        ' Si une correspondance est trouvée
        If Not matchCell Is Nothing Then
            ' Vérifier si la date est aujourd'hui ou dans les 7 jours précédents
            If IsDate(wsGlobal.Cells(numCell.Row, "G").Value) Then
                If DateValue(wsGlobal.Cells(numCell.Row, "G").Value) >= dateLimite And DateValue(wsGlobal.Cells(numCell.Row, "G").Value) <= Date Then
                    ' Si vérifié récent et présent dans OLD, colorier la ligne en rouge
                    wsGlobal.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(255, 0, 0) ' Rouge
                    ' Copier les commentaires de la feuille "OLD" vers la feuille "Global"
            Set commentairesCell = commentairesRangeOld.Cells(matchCell.Row - commentairesRangeOld.Row + 1)
            numCell.Offset(0, 12).Value = commentairesCell.Value ' Copier dans la colonne "Commentaires" de la feuille "Global"
                Else
                    ' Si non vérifié récent et présent dans OLD, colorier la ligne en orange
                    wsGlobal.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(255, 192, 0) ' Orange
                    ' Copier les commentaires de la feuille "OLD" vers la feuille "Global"
            Set commentairesCell = commentairesRangeOld.Cells(matchCell.Row - commentairesRangeOld.Row + 1)
            numCell.Offset(0, 12).Value = commentairesCell.Value ' Copier dans la colonne "Commentaires" de la feuille "Global"
                End If
            End If
        Else
            ' Si non vérifié récent (colonne D) et non présent dans OLD, colorier la ligne en rose
            If IsDate(wsGlobal.Cells(numCell.Row, "G").Value) Then
                If DateValue(wsGlobal.Cells(numCell.Row, "G").Value) >= dateLimite And DateValue(wsGlobal.Cells(numCell.Row, "G").Value) <= Date Then
                    wsGlobal.Range("A" & numCell.Row & ":N" & numCell.Row).Interior.Color = RGB(248, 203, 173) ' Rose
                End If
            End If
        End If
    Next numCell
 
    Application.ScreenUpdating = False ' Désactiver la mise à jour de l'écran pour accélérer le processus
 
    ' Créer un dictionnaire pour stocker les groupes uniques
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
 
    ' Activer la première cellule de la colonne contenant les groupes d'affectation (colonne L)
    wsGlobal.Activate
    wsGlobal.Range("L2").Select
 
 
    ' Boucle à travers chaque cellule dans la colonne des groupes d'affectation
    Do Until IsEmpty(ActiveCell)
        ' Obtenir le nom du groupes d'affectation
        groupe = ActiveCell.Value
 
 
 
    ' Si le groupes d'affectation n'est pas déjà dans le dictionnaire, le stocker
        If Not dict.Exists(groupe) Then
            dict.Add groupe, 0
        End If
 
        ' Aller à la prochaine cellule dans la colonne des groupes
        ActiveCell.Offset(1, 0).Select
    Loop
 
    ' Boucle à travers les groupes stockés dans le dictionnaire
    For Each groupe In dict.Keys
        ' Créer une nouvelle feuille de calcul avec le nom du groupe
        ThisWorkbook.worksheets.Add(After:=ThisWorkbook.worksheets(ThisWorkbook.worksheets.Count)).Name = groupe
        Set newWs = ThisWorkbook.worksheets(groupe)
 
        ' Copier la ligne d'en-tête depuis la feuille "Global"
        wsGlobal.Rows(1).Copy Destination:=newWs.Rows(1)
 
        ' Réinitialiser la variable lastRow
        lastRow = 0
 
        ' Activer la première cellule de la colonne contenant les groupes (colonne L)
        wsGlobal.Activate
        wsGlobal.Range("L2").Select
 
        ' Boucle à travers chaque cellule dans la colonne des groupes
        Do Until IsEmpty(ActiveCell)
            ' Obtenir le nom du groupe
            If ActiveCell.Value = groupe Then
                ' Vérifier si la ligne n'a pas déjà été copiée
                If ActiveCell.Row <> lastRow Then
                    ' Copier la ligne de données dans la feuille de calcul du groupe
                    wsGlobal.Rows(ActiveCell.Row).Copy Destination:=newWs.Cells(newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1, 1)
                    ' Mettre à jour la variable lastRow
                    lastRow = ActiveCell.Row
                End If
            End If
 
            ' Aller à la prochaine cellule dans la colonne des groupes
            ActiveCell.Offset(1, 0).Select
        Loop
 
' Appliquer le style au tableau sur la feuille en cours
        newWs.ListObjects.Add(xlSrcRange, newWs.UsedRange, , xlYes).TableStyle = "TableStyleLight13"
 
' LargeurColonne Macro pour chaque feuille
'
 
'
	 newWs.Cells.EntireColumn.AutoFit
     newWs.Columns("B:B").ColumnWidth = 6#
	 newWs.Columns("C:C").ColumnWidth = 10#
	 newWs.Columns("D:D").ColumnWidth = 16#
	 newWs.Columns("H:H").ColumnWidth = 57#
     newWs.Columns("J:J").ColumnWidth = 9#
	 newWs.Columns("K:K").ColumnWidth = 16#
 
    Next groupe
 
   ' Ajouter le tableau des couleurs en bas de chaque feuille
    For Each wsGlobal In ThisWorkbook.worksheets
        If wsGlobal.Name <> "OLD" Then ' Ne pas appliquer sur la feuille "OLD"
            ' Trouver la première cellule vide 5 lignes en dessous du tableau
            lastRow = wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row
            Set couleurCell = wsGlobal.Cells(lastRow + 6, 6)
 
            ' Déja vus
            couleurCell.Interior.Color = RGB(255, 192, 0) ' Orange
            couleurCell.Offset(0, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(0, 1).Value = "Déjà vus"
            couleurCell.Offset(0, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' En cours
            couleurCell.Offset(1, 0).Interior.Color = RGB(248, 203, 173) ' Rose
            couleurCell.Offset(1, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(1, 1).Value = "En cours"
            couleurCell.Offset(1, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' En attente de MEP
            couleurCell.Offset(2, 0).Interior.Color = RGB(180, 198, 231) ' Bleu clair
            couleurCell.Offset(2, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(2, 1).Value = "En attente de MEP"
            couleurCell.Offset(2, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
            ' Clos
            couleurCell.Offset(3, 0).Interior.Color = RGB(169, 208, 142) ' Vert clair
            couleurCell.Offset(3, 0).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
            couleurCell.Offset(3, 1).Value = "Clos"
            couleurCell.Offset(3, 1).BorderAround _
 ColorIndex:=1, Weight:=xlMedium
 
 SurlignerEnAttente wsGlobal
 
        End If
    Next wsGlobal
 
   '  Supprimer la feuille "OLD" à la fin
  ThisWorkbook.worksheets("OLD").Delete ' Supprimer la feuille "OLD"
 
  ' Si la feuille "OLD" n'existe pas, afficher un message et quitter la macro
    If wsOld Is Nothing Then
        MsgBox "La feuille 'OLD' n'a pas été trouvée. Veuillez vérifier votre fichier.", vbExclamation
        Exit Sub
    End If
 
    Application.ScreenUpdating = True ' Réactiver la mise à jour de l'écran
End Sub
 
'Script by XXX
 
Sub SurlignerEnAttente(wsGlobal As Worksheet)
    Dim rng As Range
    Dim cell As Range
 
    ' Spécifiez la plage de données, ajustez selon vos besoins
    Set rng = wsGlobal.Range("A2:A" & wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row)
 
    ' Parcours chaque cellule de la colonne "Ref" depuis la deuxième ligne
    For Each cell In rng
        ' Vérifie si "Ref" est "En attente"
        If cell.Offset(0, 9).Value <> "" And cell.Offset(0, 4).Value = "En attente" Then
            ' Surligne la ligne en RGB(180,198,231)
            cell.Resize(, wsGlobal.Cells(1, wsGlobal.Columns.Count).End(xlToLeft).Column).Interior.Color = RGB(180, 198, 231)
        End If
    Next cell
End Sub

[deedolith]

Je ne ferait pas confiance a une IA pour générer des codes sources.
Sachant que les IA génératives apprennent avec ce qui traîne sur internet, et la majorité des codes sources trouvés sur le net est de qualité discutable ...

[deedolith]

Autant pour moi alors,

J'en suis rendu en essayant de prendre en compte vos commentaires cela donnerais :
y a t'il d'autre choses possible ?

Une fonction qui fait 296 lignes

Je t'invite à te pencher sur ceci:
https://en.wikipedia.org/wiki/Single...lity_principle

[naozumi8]

Une fonction qui fait 296 lignes

Je t'invite à te pencher sur ceci:
https://en.wikipedia.org/wiki/Single...lity_principle

avec commentaires, mais comme je l'indiquais je ne suis pas développeur, je fait ce vba pour m'aider dans certaines taches et j'essaie d'apprendre par la même occasion.
Merci pour la page wikipedia, mais cela est trop "scolaire" et ne me parles pas.

Apres je lance le script depuis l'option développeur, visual basic ou j'y incorpore le script et fait Play, donc pour moi, tout doit tenir sur une page ? si on peut diminuer la taille ca me vas aussi, mais du coup, comment faire ?

Merci de vos aides a tous

N.B : par exemple, je voudrais que si la feuille OLD n'existe pas, tout le script n'utilisant pas cette feuille s'exécute tout de même, ou éviter de faire plusieurs fois la même boucle ?

[Valtrase]

Salut,
Comme expliqué à plusieurs reprises tu doit-être plus strict dans ta programmation
Exemples :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Renomme la feuille 1 et l'activeWorksheets(1).Name = "Global"
Worksheets(1).Activate

Je ne sais pas d'où proviennent les données de WorkSheet(1). Mais à mon avis ce n'est pas ici que tu dois nommer la feuille, si tu obtiens les données d'ailleurs alors tu dois nommer la feuille à sa creation.
De plus utiliser son index c'est pas bon du tout...celui-ci pouvant changer.

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
With wsGlobal.UsedRange
    ' Formatez la première partie de la plage
    .HorizontalAlignment = xlGeneral
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
 
    ' Formatez la deuxième partie de la plage
    With .Cells
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End With

Heu là .Cells comprends toutes les lignes y compris .UsedRange non ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    ' B : Service
    wsGlobal.Columns("B:B").ColumnWidth = 6#

Voilà, allez un commentaire car je ne me rappelle plus de ce qu'il-y-a dans la colonne "B"
Tu utilises des tableaux structurés donc utilise-les bien.

Voilà pour le début.

Si tu veux que l'on t'aide il faut déjà que tu décrive bien le sujet, car là avec des ws, wsGlobal, wsOld et autres on est un peu perdu.

[Franc]

Indépendamment de ton projet et valable pour toute macro, 99% du temps, les .Select et .Activate sont inutiles, tu peux très bien manipuler les données sans ces méthodes. Ces méthodes sont souvent sources d'erreurs et dégradent les performances.
Par exemple, tu peux faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Range("A1").Value = "blablabla"

au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sheets("Feuil1").Activate
Range("A1").Select
Range("A1").Value = "blablabla"

Quand c'est possible, utilise la structure With...End With, ça allège le code et c'est plus lisible.
Dans le cas de ta macro,au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
    wsGlobal.UsedRange.EntireColumn.AutoFit
    wsGlobal.Columns("B:B").ColumnWidth = 6
    wsGlobal.Columns("C:C").ColumnWidth = 10
    wsGlobal.Columns("D:D").ColumnWidth = 16
    wsGlobal.Columns("H:H").ColumnWidth = 57
    wsGlobal.Columns("J:J").ColumnWidth = 9
    wsGlobal.Columns("K:K").ColumnWidth = 16

tu peux faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
With wsGlobal
 
    .UsedRange.EntireColumn.AutoFit
    .Columns("B:B").ColumnWidth = 6
    .Columns("C:C").ColumnWidth = 10
    .Columns("D:D").ColumnWidth = 16
    .Columns("H:H").ColumnWidth = 57
    .Columns("J:J").ColumnWidth = 9
    .Columns("K:K").ColumnWidth = 16
 
End With

Pour éviter des macros de plusieurs centaines de lignes, difficiles à maintenir, tu peux découper en macros plus petites pour éffectuer certaines tâches et que tu appelles au bon endroit. Par exemple, la partie ou tu ajoutes les tableaux couleur, pourrait être mise dans une macro à part.
Voilà quelques pistes pour améliorer ton code.