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
| Option Explicit
Sub MAJGroupe()
Dim wsGlobal As Worksheet
Dim wsOld As Worksheet
Dim lastRowGlobal As Long
Dim lastRowOld As Long
Dim idRangeGlobal As Range
Dim statutRangeOld As Range
Dim idRangeOld As Range
Dim groupeRangeOld As Range
Dim statutCell As Range
Dim idCell As Range
Dim groupeCell As Range
Dim matchCellGlobal As Range
Dim matchCellGroup As Range
Dim matchCellOldID As Range
Dim i As Integer
Dim Couleurs As Variant
Set wsGlobal = ThisWorkbook.Sheets("Global")
On Error Resume Next
Set wsOld = ThisWorkbook.Sheets("Extract")
On Error GoTo 0
' Si la feuille "Extract" n'existe pas, afficher un message et quitter la macro
If wsOld Is Nothing Then
MsgBox "La feuille 'Extract' n'a pas été trouvée. La prise en compte de l'ancien Backlog n'as pu donc être effectuée.Merci de cliquer sur CREER", vbExclamation
Exit Sub
End If
lastRowGlobal = wsGlobal.Cells(wsGlobal.Rows.Count, "A").End(xlUp).Row
lastRowOld = wsOld.Cells(wsOld.Rows.Count, "A").End(xlUp).Row
Set idRangeGlobal = wsGlobal.Range("A2:A" & lastRowGlobal)
Set statutRangeOld = wsOld.Range("E2:E" & lastRowOld)
Set idRangeOld = wsOld.Range("A2:A" & lastRowOld)
Set groupeRangeOld = wsOld.Range("L2:L" & lastRowOld)
' Parcourir chaque cellule de la colonne "A" de la feuille "Global"
For Each idCell In idRangeGlobal
' Recherche de la correspondance dans la feuille "Extract" en utilisant l'identifiant commun
Set matchCellOldID = idRangeOld.Find(idCell.Value, LookIn:=xlValues)
If matchCellOldID Is Nothing Then
' Si l'identifiant n'est pas trouvé dans la feuille "Extract", alors mettre "Résolu" dans la ligne correspondante
wsGlobal.Range("E" & idCell.Row).Value = "Résolu"
wsGlobal.Range("M" & idCell.Row).Value = "Résolu"
' Colorier la ligne dans la feuille "Global"
wsGlobal.Range("A" & idCell.Row & ":N" & idCell.Row).Interior.Color = RGB(169, 208, 142)
' Utilisation du groupe pour déterminer la feuille destination
Dim wsGlobalGroup As Worksheet
On Error Resume Next
Set wsGlobalGroup = ThisWorkbook.Sheets(wsGlobal.Range("L" & idCell.Row).Value)
On Error GoTo 0
If Not wsGlobalGroup Is Nothing Then
' Recherche de la correspondance dans la feuille du groupe en utilisant l'identifiant commun
Set matchCellGroup = wsGlobalGroup.Range("A:A").Find(idCell.Value, LookIn:=xlValues)
If Not matchCellGroup Is Nothing Then
' Mettre "Résolu" dans la ligne correspondante de la feuille du groupe
wsGlobalGroup.Range("E" & matchCellGroup.Row).Value = "Résolu"
wsGlobalGroup.Range("M" & matchCellGroup.Row).Value = "Résolu"
' Colorier la ligne dans la feuille du groupe
wsGlobalGroup.Range("A" & matchCellGroup.Row & ":N" & matchCellGroup.Row).Interior.Color = RGB(169, 208, 142)
End If
End If
End If
Next idCell
' Supprimer la feuille "Extract" à la fin
ThisWorkbook.Worksheets("Extract").Delete ' Supprimer la feuille "Extract"
Application.ScreenUpdating = True ' Réactiver la mise à jour de l'écran
End Sub |
Partager