Aide Macro - mettre données présentées en ligne en colonne (post 2)

Bonjour à tous,

J'ai sollicité votre aide il y a quelques mois pour la construction d'une macro et pour laquelle @h2so4 m'a été d'une très grande aide et je l'en remercie à nouveau. Ce post est disponible ici : https://forum.excel-pratique.com/excel/aide-macro-mettre-donnees-presentees-en-ligne-en-colonne-1399...

Néanmoins, j'ai besoin de faire évoluer cette macro. Je vous en explique le fonctionnement :

Cette macro permet à partir d’extractions de données disposées en lignes, de transposer celles-ci en colonnes. La macro réalise les tâches suivantes :

• On renseigne un paramètre de boucle (toujours identique) qui indiquera quand passer à la ligne suivante (dans mon exemple "Page");
• On renseigne le nom du paramètre situé dans la 1ere cellule sous mon paramètre de boucle et qui deviendra mon intitulé de ligne (dans mon exemple un numéro de matricule);
• Tous les intitulés situés sous la 1ere cellule devront se disposer en colonne et renseigner les valeurs des extractions brutes.

L’onglet ‘données illustre le type d’extractions dont je dispose.

L’onglet ‘intitul à mettre en col renseigne tous les intitulés qui me sont nécessaires ainsi que la colonne où aller chercher la valeur dans l’extraction brute

L’onglet ‘rendu illustre le résultat final que je souhaite obtenir.

L'évolution que je souhaite apporter au programme est :-

• Dans l'onglet 'intitul à mettre en col, pouvoir choisir uniquement les intitulés que je souhaite sans être obligé de mettre l'ensemble de mes intitulés existants. Actuellement, si je supprime un intitulé au milieu de ma liste, j'ai un bug sur la ligne VBA "wsr.Cells(dlr, dictrendu(v)) = wsd.Cells(i, dictcol(v))".
• Si possible et ce serait pour moi un petit bonus: si entre deux paramètre de boucle, un intitulé apparaît 2 fois, le rendu me renverra la somme pour le matricule concerné. Actuellement s'il apparait deux fois, seul le 1er est retenu dans mon rendu, le deuxième passe à la trappe

Je vous remercie par avance de l'aide que vous pourrez m'apporter et reste dispo pour tout complément d'information.

Bonne journée à tous.

Denver

bonjour,

voici une adaptation du code. (sélection et somme pour un même intitulé)

Option Explicit
Sub aargh()
Dim wsd As Worksheet
Dim wsr As Worksheet
Dim wsi As Worksheet
Dim dli&, dld&, dlr&, i&, dcr&
Dim dictcol As Object, dictrendu As Object, v$

    Set wsd = Sheets("données")
    dld = wsd.Cells(Rows.Count, 1).End(xlUp).Row
    Set wsi = Sheets("intitul à mettre en col")
    With wsi
        dli = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dictcol = CreateObject("scripting.dictionary")
        For i = 2 To dli
            dictcol(.Cells(i, 1).Value) = .Cells(i, 2)
        Next i
    End With
        Set wsr = Sheets("rendu")
    wsr.Cells.ClearContents
    wsi.Range("A2:A" & dli).Copy
    wsr.Range("B1").Resize(1, dli - 1).PasteSpecial xlPasteValues, Transpose:=True
    dcr = wsr.Cells(1, Columns.Count).End(xlToLeft).Column
    Set dictrendu = CreateObject("scripting.dictionary")
    For i = 1 To dcr
        dictrendu(wsr.Cells(1, i).Value) = i
    Next i
    dlr = 1
    i = 1
    Do While i <= dld
        v = wsd.Cells(i, 1)
        If v <> "" Then
        If UCase(v) = "PAGE" Then
            dlr = dlr + 1
            i = i + 1
            wsr.Cells(dlr, 1) = wsd.Cells(i, 1)
        Else
            If dictrendu(v) <> "" Then wsr.Cells(dlr, dictrendu(v)) = wsr.Cells(dlr, dictrendu(v)) + wsd.Cells(i, dictcol(v))
        End If
        End If
        i = i + 1
    Loop
End Sub

h2so4, mille mercis. Dans le mille encore une fois !!

Je suis refait !

Une très bonne journée.