Sub Dispatch()
Dim TDon(), LD As Long, DicTrs As New Dictionary, TGDr(), LG As Long, _
C As Long, Détail, Dst As SsGr, TR(), LR As Long, Wsh As Worksheet, RAS As Boolean
TDon = PlgUti(WshTrans.[A2]).Value
For LD = 1 To UBound(TDon, 1): DicTrs(TDon(LD, 1)) = True: Next LD
TGDr = PlgUti(WshGDrv.[A2]).Value: LD = 0
ReDim TDon(1 To 100000, 1 To 9)
For LG = 1 To UBound(TGDr, 1)
If DicTrs.Exists(TGDr(LG, 5)) Then
LD = LD + 1
For C = 1 To 8: TDon(LD, C) = TGDr(LG, C): Next C
TDon(LD, 9) = "Folder Owner"
For Each Détail In Split(TDon(LD, 7), ",")
If Not DicTrs.Exists(Détail) Then
LD = LD + 1
For C = 1 To 6: TDon(LD, C) = TGDr(LG, C): Next C
TDon(LD, 7) = Détail
TDon(LD, 8) = TGDr(LG, 8)
TDon(LD, 9) = "Deputy not transferred"
End If: Next Détail: End If
RAS = True
For Each Détail In Split(TGDr(LG, 8), ",")
If DicTrs.Exists(Détail) Then
LD = LD + 1
For C = 1 To 7: TDon(LD, C) = TGDr(LG, C): Next C
TDon(LD, 8) = Détail
Select Case True
' … Remettre les instructions actuelles
Case Else: TDon(LD, 9) = "Other": End Select
RAS = False: End If: Next Détail
If RAS Then
LD = LD + 1
For C = 1 To 8: TDon(LD, C) = TGDr(LG, C): Next C
TDon(LD, 9) = "Aucun transfert"
End If: Next LG
MGigogne.DernièreLigneÀIndexer = LD
For Each Dst In Gigogne(TDon, 9)
ReDim TR(1 To 500, 1 To 10): LR = 0
For Each Détail In Dst.Co
LR = LR + 1
For C = 1 To 8: TR(LR, C) = Détail(C): Next C, Détail
Set Wsh = ThisWorkbook.Worksheets(Dst.Id)
With Wsh.[K2:I10000]: .ClearContents: .Interior.ColorIndex = xlColorIndexNone: End With
Wsh.[A2].Resize(UBound(TR, 1), UBound(TR, 2)) = TR
Wsh.Names.Add "Flag", Wsh.[I2].Resize(LR)
Wsh.[Flag].Interior.Color = &HB8FD00
Wsh.[Flag].Offset(, -1).Interior.Color = &HBDFF9D
Next Dst
End Sub