Sub Distribuer()
Dim Games(), Game As SsGroup, Ls&, Détail, C&, Tr(), F As Worksheet
Games = Array("P2683", "P1650")
Tr = PlgUti(Feuil1.[A2]).Resize(, 6).Value
For Ls = 1 To UBound(Tr)
Tr(Ls, 6) = "DEFLECTEURS"
For C = LBound(Games) To UBound(Games)
If Tr(Ls, 4) Like "*" & Games(C) & "*" Then Tr(Ls, 6) = Games(C): Exit For
Next C, Ls
For Each Game In GroupOrg(Tr, 6)
On Error Resume Next
Set F = Worksheets(Game.Id): If Err Then Set F = Nothing
On Error GoTo 0
If F Is Nothing Then
MsgBox "La feuille """ & Game.Id & """ n'existe pas" _
& vbLf & "==> Game ignoré.", vbCritical, "Distribuer"
Else
ReDim Tr(1 To Game.Contenu.Count, 1 To 5)
Ls = 0
For Each Détail In Game.Contenu
Ls = Ls + 1: For C = 1 To 5: Tr(Ls, C) = Détail(C): Next C
Next Détail
F.UsedRange.ClearContents
F.[A1:E1].Value = Feuil1.[A1:E1].Value
F.[A2].Resize(UBound(Tr, 1), 5).Value2 = Tr ' Value2 pour éviter bogue sur dates françaises
F.[A2].Resize(UBound(Tr, 1)).NumberFormat = "m/d/yyyy"
F.[A:E].Columns.AutoFit: End If: Next Game
End Sub