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

[abouilies]

Bonsoir à tous,
Je me permets de vous solliciter pour de l'aide sur VBA.
J'ai tenté sur excel avec index equiv de copier mes données sans y parvenir.
Ma demande est la suivante : je souhaiterai copier les données se trouvant en feuil1 vers une autre feuille pour élaborer un tableau agencé par date, type activité, par agent et coller la valeur selon les 3 critères évoqués.
Je me suis permis de mettre un exemple du résultat attendu (en feuil2).
Je vous remercie infiniment pour l'aide que vous pourrez m'apportée et ma gratitude à ceux qui auront lu ma demande.
Portez vous bien.

Abouilies

 

[mapomme]

Bonjour @abouilies 🙂,

Un essai dans le fichier joint. Cliquez sur le bouton Hop!
Le code est dans module1 :

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

 

[abouilies]

Bonjour MaPomme,
Un immense merci et toute ma gratitude, le code fonctionne à merveille. Je viens de le tester aussi sur une plage plus importante.
Encore merci d'avoir répondu aussi rapidement.

 

[JHA]

Bonjour à tous,
Bonjour @mapomme 😉

Il y a également une solution avec Power Query (sans VBA).
Je t'ai mis un exemple sur le fichier de MaPomme.

JHA

 

[abouilies]

Bonjour JHA, je viens de prendre connaissance l'agencement avec Power Query. C'est super, le résultat est bluffant.
Merci JHA