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

abouilies

XLDnaute Nouveau
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
 

Pièces jointes

  • testxld.xlsx
    11.9 KB · Affichages: 2

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @abouilies :),

Un essai dans le fichier joint. Cliquez sur le bouton Hop!
Le code est dans module1 :
VB:
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
 

Pièces jointes

  • abouilies- Ventiler- v1.xlsm
    22.7 KB · Affichages: 8

Discussions similaires

Statistiques des forums

Discussions
315 056
Messages
2 115 782
Membres
112 541
dernier inscrit
J-c2417