XL 2019 VBA - Copie données selon 3 critères

Sub Ventiler()
Dim t, i&, n&, j&
   t = Sheets("Feuil1").Range("a1").CurrentRegion  ' lecture du tableau des valeurs sources
   ReDim r(1 To 1 + 8 * UBound(t), 1 To 4)         ' création du tableau résultat r
   ' les titres de r
   r(1, 1) = "Date": r(1, 2) = "ACTIVITE": r(1, 3) = "Agent": r(1, 4) = "Valeur": n = 1
   For i = 2 To UBound(t)     ' pour chaque ligne du tableau de la source
      For j = 2 To 9          ' pour chaque activité de la ligne i
         n = n + 1            ' incrémentation de la ligne du tableau résultat
         r(n, 1) = t(i, 1)    ' la date dans r
         r(n, 2) = t(1, j)    ' l'activité dans r
         r(n, 3) = t(i, 10)   ' l'agent dans r
         r(n, 4) = t(i, j)    ' la valeur de l'activité dans r
      Next j
   Next i
   With Sheets("Feuil2")
      .Columns("a:d").ClearContents             ' effacement des 4 colonnes résultats
      .Range("a1").Resize(UBound(r), 4) = r     ' transfert du tableau résultat r sur la feuille
   End With
End Sub