Tableau Transposition colonne

Question

Voilà je suis nouveau sur ce forum. J’ai une expérience classique d’excel. Dans le cadre de mon travail je suis amené à travailler sur des bases de données et plus particulièrement sur des BDD qui génèrent des graphiques dynamiques (qui se mettent à jour automatiquement suivant la ressource excel). Je cherche de l’aide car pour importer ces données dans mes logiciels graphique je suis obligé d’intervenir sur le fichiers source excel. De basculer les colonnes (un simple collage spécial transposé) ne suffit pas à résoudre. J’ai testé plusieurs solutions sans véritable succès car je cherche à automatiser la solution. Peut être avec un ou des scripts mais là cela dépasse mes compétences. Il y a certainement un membre sur le forum qui a une solution. J’ai joins un fichier test source et un fichier du résultat souhaité (ici fait manuellement car peu de ressources, mais si j’ai 500 lignes j’aimerais vraiment automatiser un maximum). Problème 1 : (1ere colonne « UI » tableau résultat) - Dans le classeur résultat 1ere colonne (UI) je dois aller chercher la valeur cible dans le classeur source (colonne UI) et répéter cette valeur sélectionnés 20 fois dans le tableau résultat puis passer à la valeur suivante automatiquement et la répéter 20 fois dans le classeur résultat et ainsi de suite jusque au moment ou il n’y a plus de valeur dans la colonne UI du classeur source. Problème 2 (2nd colonne « Type » tableau résultat) - Pour la 2nd colonne je dois aller chercher la valeur cible dans le classeur source ici première valeur "CPSécuritéSociale" (et passer automatiquement à celle qui est à droite et ainsi de suite jusqu’à une valeur d’arrêt choisie (ici Total Charge salariale) et répéter cette opération autant de fois qu’il y a de valeur UI du tableau source. Problème 3 (3eme colonne « Montant » tableau résultat) - Pour la 3eme colonne je doit aller chercher la valeur référence et la valeur cible dans le classeur source et passer automatiquement à celle qui est à droite et ainsi de suite jusqu’a une valeur d’arrêt choisie (ici Total Charge salariale) et répéter cette opération autant de fois qu’il y a de valeur (UI tableau source). Je ne sait pas si j’ai été bien clair. Mais si quelqu’un à des idées ou des solutions à mon problème cela serait super. Merci à vous de m’avoir lu. Et à tous ceux qui prendront le temps de me répondre...

Jean-Eric · Answer

Une proposition. ALT F8 puis exécuter la procédure 'Consolider_donnees'. Cdlt...

Jean-Eric · Answer

Re,

ALT F11 pour ouvrir l'éditeur VBE

Voir procédure dans Module1.

Le code est prévu pour fonctionner avec un nombre de lignes et de colonnes variables.

Mais la mise en forme du tableau n'est prévue que pour les CP et CS!?.

Alors prudence.

(voir parties surlignées ci-dessous)

A te relire.

Cdlt.

Option Explicit
'Option Private Module

Public Sub Consolider_donnees()
Dim wb As Workbook
Dim wsData As Worksheet
Dim lastCol As Long, lastRow As Long, lRow As Long
Dim i As Long, j As Long
Dim lo As ListObject
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim calcMode As XlCalculation

    With Application
        calcMode = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set wb = ThisWorkbook
    On Error Resume Next
    wb.Worksheets("Résultat").Delete
    On Error GoTo 0
    Set wsData = wb.Worksheets("General")

    wb.Worksheets.Add After:=wb.Worksheets(1)
    ActiveSheet.Name = "Résultat"
    [A1:D1] = Array("UI", "Charge", "Libellé", "Montant")
    lRow = 2
    With wsData
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To lastRow
            For j = 2 To lastCol
                If Left(.Cells(1, j), 5) <> "Total" Then
                    Cells(lRow, 1) = .Cells(i, 1)   'UI
                   Cells(lRow, 2) = Left(.Cells(1, j), 2)  'Charge (2ers. caractères)
                    Cells(lRow, 3) = Mid(.Cells(1, j), 4, Len(.Cells(1, j)))    'Charge (caracteres suivants)
                    Cells(lRow, 4) = .Cells(i, j)   'Montant
                    lRow = lRow + 1
                End If
            Next j
        Next i
    End With

    With Columns(2)
       .Replace "CP", "Charges patronales"
        .Replace "CS", "Charges sociales"
    End With

    Set lo = ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Cells(1).CurrentRegion, , xlYes)
    With lo
        .Name = "Table1"
        .TableStyle = "TableStyleLight14"
    End With

    Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 4)
    Set pt = ptCache.CreatePivotTable(Cells(6), "PT_1", , 4)
    With pt
        .ManualUpdate = True
        .AddFields RowFields:=Array("UI", "Charge", "Libellé")
        With .PivotFields("Montant")
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0.00;[Red](#,##0.00);"
            .Caption = "Montant "
        End With
        .RowAxisLayout xlTabularRow
        .TableStyle2 = "PivotStyleMedium8"
        .PivotFields("UI").Subtotals(1) = True
        .PivotFields("Charge").Subtotals(1) = True
        .ManualUpdate = False
    End With

    ActiveWindow.DisplayGridlines = False
    [A1:H1].EntireColumn.AutoFit
    [A1].Select

    With Application
        .Calculation = calcMode
        .DisplayAlerts = True
        .EnableEvents = True
    End With

    Set pt = Nothing
    Set ptCache = Nothing
    Set lo = Nothing
    Set wsData = Nothing
    Set wb = Nothing

End Sub

ThauThème · Answer

Une autre proposition avec le code ci-dessous. À placer dans le fichier Source (qui devient .xlsm à cause de la macro). Pour que le code fonctionne, il faut que le second fichier porte le même nom que dans ton exemple : TableauResultat.xlsx et que : • soit que les deux fichiers soient ouverts • soit qu'ils soient enregistrés dans le même dossier que le classeur Source... Je n'ai pas fait de mise en forme j'ai juste séparés les bloc par une ligne. Tu peux supprimer la ligne vide en remplaçant la ligne : Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0) 'définit la celule de destination DEST par : Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la celule de destination DEST Le code : Sub Macro1() Dim CS As Workbook 'déclare la variable CS (Classeur Source) Dim CH As String 'déclare la variable CH (CHemin d'accès) Dim OS As Worksheet 'déclare la variable OS (Onglet Source) Dim CD As Workbook 'déclare la variable CD (Classeur Destination) Dim OD As Worksheet 'déclare la variable OD (Onglet Destination) Dim TC As Variant 'déclare la variable TC (Tableau de Cellules) Dim I As Integer 'déclare la variable I (Incrément) Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) Set CS = ThisWorkbook 'définit le classeur source CS CH = CS.Path &amp; "\" 'définit le chemin CH Set OS = CS.Sheets("General") 'définit l'onglet source OS On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante) Set CD = Workbooks("TableauResultat.xlsx") 'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert) If Err &lt;&gt; 0 Then 'condition : si une erreur a été générée Err.Clear 'efface l'erreur Application.Workbooks.Open (CH &amp; "TableauResultat.xlsx") 'ouvre le classeur "TableauResultat.xlsx" Set CD = ActiveWorkbook 'définit le classeur destination CD End If 'fin de la condition On Error GoTo 0 'annule la gestion des erreur Set OD = CD.Sheets("Feuil1") 'définit l'onglet destination OD OD.Range("A1").CurrentRegion.Offset(1, 0).Clear 'efface toutes les anciennes données de l'onglet destination OD TC = OS.Range("A1").CurrentRegion 'définit le tableau de cellules TC For I = 2 To UBound(TC, 1) 'boucle sur toutes les lignes I du tableau de cellules TC (en partant de la seconde) Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0) 'définit la celule de destination DEST 'renvoie dans DEST redimensionnée à 22 lignes la valeut en ligne I colonne 1 de TC DEST.Resize(22, 1).Value = TC(I, 1) 'renvoie dans DEST décalée d'un colonne à droite et redimensionnée à 22 lignes la première ligne de TC DEST.Offset(0, 1).Resize(22, 1).Value = Application.Transpose(Application.Index(TC, 1)) 'renvoie dans DEST décalée de deux colonnes à droite et redimensionnée à 22 lignes, la ligne I de TC DEST.Offset(0, 2).Resize(22, 1) = Application.Transpose(Application.Index(TC, I)) OD.Rows(DEST.Row).Delete 'efface la ligne de DEST Next I 'prochaine ligne de la boucle End Sub...

Klin89 · Answer

Bopnsoir le forum,

Résultat en Feuil2:

Sub Transpose()
Dim a, b(), i As Long, j As Long, n As Long
    With Sheets("General").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To Application.CountA(.Cells), 1 To 3)
    End With
    For i = 2 To UBound(a, 1)
        For j = 2 To UBound(a, 2)
            n = n + 1
            b(n, 1) = a(i, 1)
            b(n, 2) = a(1, j)
            b(n, 3) = a(i, j)
        Next
    Next
    With Sheets("Feuil2").Cells(1).Resize(, 3)
        .CurrentRegion.ClearContents
        .Value = [{"UI","Type","Montant CS"}]
        .Offset(1).Resize(n).Value = b
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            With .Rows(1)
                .Font.Size = 11
                .Interior.ColorIndex = 43
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
    End With
End Sub

klin89