Autres Faire un récapitulatif de plusieurs jours dans une même feuille

Private Sub Worksheet_Activate()
Call Planning_Affectations
End Sub

Sub Planning_Affectations()
Set dico = CreateObject("Scripting.dictionary")
feuilles = Array("Jeudi", "Vendredi", "Samedi", "Dimanche", "Lundi")
For p = LBound(feuilles) To UBound(feuilles)
Set sh = Sheets(feuilles(p))
  If Not sh.Name Like "Planning*" Then
      For n = 8 To sh.Range("G" & Rows.Count).End(xlUp).Row
      If sh.Range("B" & n) <> "" Then
         lieu = sh.Range("B" & n)
         Heure = sh.Range("F" & n)
         Travail = sh.Range("C" & n)
      End If
          If sh.Range("G" & n) <> "" Then
              ShtName = sh.Name
              dico(ShtName) = dico(ShtName) & sh.Range("G" & n) & "|" & lieu & "|" & Heure & "|" & Travail & ";"
          End If
      Next
  End If
Next
a = dico.keys
b = dico.items
For n = LBound(a) To UBound(a)
  For m = LBound(a) To UBound(a)
      no_n = InStr(Join(feuilles, ","), a(n))
      no_m = InStr(Join(feuilles, ","), a(m))
      If no_n < no_m Then
          tempa = a(n)
          tempb = b(n)
          a(n) = a(m)
          b(n) = b(m)
          a(m) = tempa
          b(m) = tempb
      End If
   Next
Next
Application.ScreenUpdating = False
With Sheets("Planning Affectations")
    .Range("A3:F" & Rows.Count).ClearContents
ligne = 4
For n = LBound(a) To UBound(a)
  x = Split(b(n), ";")
  For m = LBound(x) To UBound(x) - 1
      .Range("B" & ligne) = a(n)
      .Range("D" & ligne) = Split(x(m), "|")(0)
     
      .Range("F" & ligne) = CDate(Split(x(m), "|")(2)) 'heure
     
      .Range("C" & ligne) = Split(x(m), "|")(3)
      .Range("E" & ligne) = Split(x(m), "|")(1)
   
      ligne = ligne + 1
  Next
  ligne = ligne + 1
Next
End With
End Sub