Creation d'une macro - regroupement de donnees de deux rapports differents

Le 14/10/2019 à 16:44

Bonjour a tous,

Je me permets de creer ce poste car je souhaiterai travailler a l'aide d'une macro qui me faciliterait la tache de facon quotidienne dans mon travail.

Je travaille sur l'analyse de donnees issues de deux rapports differents. De ces deux rapports j'extraits les numeros de contrats associes aux unites presentes dans ce contrat. Seulement voila, le nombre d'unites relies au contrat peut s'etaler sur differentes cellules (pour comprendre de facon plus claire, je joins un fichier excel qui illustre mon cas). Ainsi, je souhaiterais, creer une macro qui me permettrait de creer la somme des unites par rapport au numero du contrat de maniere a rendre plus simple la comparaison entre les donnees issues des deux differents rapprots.

Habituellement, pour reunir les donnes reliees a un contrat j'utilisee, la fonction "pivot table", mais je voulais savoir s'il etait possible d'automatiser cette manipulation via une macro.

Je suis preneur de tout conseil, n'etant pas du tout un specialiste des macros, je n'en ai jamais realise

Merci infiniment de votre aide (veuillez m'excuser pour le texte sans accent, j'utilise un clavier anglo-saxon )

8exemple-rapport.xlsx (8.83 Ko)
Le 14/10/2019 à 16:56

Tu peux aussi faire 2 TCD en prévoyant des plages plus long pour tes prochaines importations de données.

Ensuite un simple clic droit sur le tcd et tes données seront à jour pour la comparaison.

4exemple-rapport-1.xlsx (16.00 Ko)
Le 14/10/2019 à 17:33

Bonjour,

Une macro pour t'aider avec comme base le fichier que tu as transmis.

Sub Macro11() Range("B41").Select Sheets.Add After:=Sheets(Sheets.Count) Sheets("Feuil8").Name = "Tempo" Sheets("Sheet1").Select Range("C1").Select Selection.CurrentRegion.Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C3:R16C4", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Tempo!R1C1", TableName:="Tableau croisé dynamique7", _ DefaultVersion:=xlPivotTableVersion14 Sheets("Tempo").Select Cells(1, 1).Select ActiveSheet.PivotTables("Tableau croisé dynamique7").AddDataField ActiveSheet. _ PivotTables("Tableau croisé dynamique7").PivotFields("Unites"), _ "Somme de Unites", xlSum With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields( _ "Rapport1") .Orientation = xlRowField .Position = 1 End With Selection.CurrentRegion.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Rapport-1" Range("B1").Select ActiveCell.FormulaR1C1 = "Unités" Range("B2").Select Sheets("Sheet1").Select Range("F1").Select Selection.CurrentRegion.Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C6:R19C7", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Tempo!R1C4", TableName:="Tableau croisé dynamique8", _ DefaultVersion:=xlPivotTableVersion14 Sheets("Tempo").Select Cells(1, 4).Select ActiveSheet.PivotTables("Tableau croisé dynamique8").AddDataField ActiveSheet. _ PivotTables("Tableau croisé dynamique8").PivotFields("Unites"), _ "Somme de Unites", xlSum With ActiveSheet.PivotTables("Tableau croisé dynamique8").PivotFields( _ "Rapport2") .Orientation = xlRowField .Position = 1 End With Selection.CurrentRegion.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Rapport-2" Range("E1").Select ActiveCell.FormulaR1C1 = "Unité" Range("F1").Select ActiveCell.FormulaR1C1 = "Ecart" Range("F2").Select ActiveCell.FormulaR1C1 = _ "=+SUMIF(C[-5],RC[-5],C[-4])-SUMIF(C[-2],RC[-5],C[-1])" Range("F2").Select Selection.AutoFill Destination:=Range("F2:F9") Range("F2:F9").Select Range("F1").Select End Sub

Le 14/10/2019 à 17:35
Xmenpl a écrit :

Tu peux aussi faire 2 TCD en prévoyant des plages plus long pour tes prochaines importations de données.

Ensuite un simple clic droit sur le tcd et tes données seront à jour pour la comparaison.

exemple rapport (1).xlsx

Salut Xmenpl,

Top, merci beaucoup pour ton aide

Il suffit donc de supprimer les donnes reliees aux TCD puis coller les nouvelles et actualiser les TDC pour avoir les donnees a jour, si j'ai bien compris?

Le 14/10/2019 à 17:40

Hey salut bitaljoe

Waaw, enorme, merci infiniment! Je vais m'empresser de la tester

Encore merci pour ton aide precieuse,

Excellente journee

Le 14/10/2019 à 17:47

Essai celle-ci, il y avait un bug sur l'autre.

Sub Macro11() Range("B41").Select Sheets.Add After:=Sheets(Sheets.Count) Sheets("Feuil8").Name = "Tempo" Sheets("Sheet1").Select Range("C1").Select Selection.CurrentRegion.Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C3:R16C4", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Tempo!R1C1", TableName:="Tableau croisé dynamique7", _ DefaultVersion:=xlPivotTableVersion14 Sheets("Tempo").Select Cells(1, 1).Select ActiveSheet.PivotTables("Tableau croisé dynamique7").AddDataField ActiveSheet. _ PivotTables("Tableau croisé dynamique7").PivotFields("Unites"), _ "Somme de Unites", xlSum With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields( _ "Rapport1") .Orientation = xlRowField .Position = 1 End With Selection.CurrentRegion.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Rapport-1" Range("B1").Select ActiveCell.FormulaR1C1 = "Unités" Range("B2").Select Sheets("Sheet1").Select Range("F1").Select Selection.CurrentRegion.Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C6:R19C7", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Tempo!R1C4", TableName:="Tableau croisé dynamique8", _ DefaultVersion:=xlPivotTableVersion14 Sheets("Tempo").Select Cells(1, 4).Select ActiveSheet.PivotTables("Tableau croisé dynamique8").AddDataField ActiveSheet. _ PivotTables("Tableau croisé dynamique8").PivotFields("Unites"), _ "Somme de Unites", xlSum With ActiveSheet.PivotTables("Tableau croisé dynamique8").PivotFields( _ "Rapport2") .Orientation = xlRowField .Position = 1 End With Selection.CurrentRegion.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Rapport-2" Range("E1").Select ActiveCell.FormulaR1C1 = "Unité" Range("F1").Select ActiveCell.FormulaR1C1 = "Ecart" Range("F2").Select ActiveCell.FormulaR1C1 = _ "=+SUMIF(C[-5],RC[-5],C[-4])-SUMIF(C[-2],RC[-5],C[-1])" Range("F2").Select Selection.AutoFill Destination:=Range("F2:F9") Range("F2:F9").Select Range("F1").Select End Sub

Le 14/10/2019 à 17:59

Oops, j'ai tente de lancer la macro mais j'ai toujours un message d'erreur :/ Est-il possible de faire marcher la macro en l'enregistrant et en la faisant marcher pour un nouveau tableau sur une nouvelle fiche excel ?

Le 14/10/2019 à 18:11

Voilà une qui marche à merveille pour tout nouveau fichier !

Sub Macro11() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets.Add(After:= _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ws.Name = "Tempo" Sheets("Sheet1").Select Range("C1").Select Selection.CurrentRegion.Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C3:R16C4", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Tempo!R1C1", TableName:="Tableau croisé dynamique7", _ DefaultVersion:=xlPivotTableVersion14 Sheets("Tempo").Select Cells(1, 1).Select ActiveSheet.PivotTables("Tableau croisé dynamique7").AddDataField ActiveSheet. _ PivotTables("Tableau croisé dynamique7").PivotFields("Unites"), _ "Somme de Unites", xlSum With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields( _ "Rapport1") .Orientation = xlRowField .Position = 1 End With Selection.CurrentRegion.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Rapport-1" Range("B1").Select ActiveCell.FormulaR1C1 = "Unités" Range("B2").Select Sheets("Sheet1").Select Range("F1").Select Selection.CurrentRegion.Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Sheet1!R1C6:R19C7", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Tempo!R1C4", TableName:="Tableau croisé dynamique8", _ DefaultVersion:=xlPivotTableVersion14 Sheets("Tempo").Select Cells(1, 4).Select ActiveSheet.PivotTables("Tableau croisé dynamique8").AddDataField ActiveSheet. _ PivotTables("Tableau croisé dynamique8").PivotFields("Unites"), _ "Somme de Unites", xlSum With ActiveSheet.PivotTables("Tableau croisé dynamique8").PivotFields( _ "Rapport2") .Orientation = xlRowField .Position = 1 End With Selection.CurrentRegion.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D1").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "Rapport-2" Range("E1").Select ActiveCell.FormulaR1C1 = "Unité" Range("F1").Select ActiveCell.FormulaR1C1 = "Ecart" Range("F2").Select ActiveCell.FormulaR1C1 = _ "=+SUMIF(C[-5],RC[-5],C[-4])-SUMIF(C[-2],RC[-5],C[-1])" Range("F2").Select Selection.AutoFill Destination:=Range("F2:F9") Range("F2:F9").Select Range("F1").Select End Sub

Les données de départ doivent toujours être dans une feuille nommé "Sheet1"; et commencer de

[attachment=0]

ext1.PNG

[/attachment]

ext1
Le 14/10/2019 à 18:32

Genial 10000 mercis mon ami(e), je t'en suis tres reconnaissant

Passe une excellente fin de journee

Le 14/10/2019 à 18:43

Un petit J'aime ne ferais pas de mal !!!

Le 14/10/2019 à 20:01

Bonjour à tous,

@yac18060 : clique sur le bouton "Répondre" pour répondre à un message (et non "Citer").

@©bitaljoe : tu ne dois pas demander des "J'aime" à ceux que tu aides (voir la charte du forum).

Cordialement,

Le 15/10/2019 à 16:38

Bonjour bitaljoe

Je me permets de revenir vers toi suite a la macro que j'essaie d'utiliser

Une fois enregistree, celle-ci ne parvient malheureusement pas a prendre en compte la totalite des informations presentes dans mon fichier. Y-a-t-il une manipulation a realiser de facon a ce que la macro puisse prendre en compte une plus large plage de donnees ?

Encore merci de l'aide

Le 15/10/2019 à 17:08

en effet, il est possible que si sur tous tes classeurs, les données ne sont pas dans

Sheets("Sheet1").Select

alors la macro va chercher à trouver cette feuille et sélectionner les données qui s'y trouve.

pour ce qui est de la plage plus grande, un fichier d'exemple ou merci de citer la largeur de la plage pour les types de rapport.

Le 15/10/2019 à 17:42

Tres bien je vois c'est clair! Est-il possible tu penses de configurer la macro de facon a ce qu'elle puisse prendre en compte une colonne d'information avec 2000 cellules d'information ? De facon a ce que la macro absorbe toutes les informations peu importe la taille de la colonne (inferieur ou egal a 2000)

Mille mercis

Le 15/10/2019 à 17:58

Oui c'est déjà ce qu'elle fait.

Maintenant, :

* soit tu t'arrange à ce que tous tes nouveaux classeurs ait toujours une feuille nommé "Sheet1" et dont les données des rapports qui s'y trouve n'ai que deux colonnes et X lignes.

* soit on ce dit qu'il y aura toujours des feuilles nommés "Rapport_1" et "Rapport_2" avec les data de chaque rapports peut importe les colonnes des rapports et on refait une macro prenant cela en compte.

Le 15/10/2019 à 21:17

Bonsoir,

Alors pour etre honnete apres avoir essaye plusieurs fois, je n'arrive toujours pas a avoir le resultat escompte. Pourtant toutes les informations des deux rapports sont bien regroupees dans une feuille excel dans deux colonnes differentes avec x lignes. Pour que cela soit plus clair je joins un exemple de resultat que j'ai pu avoir apres utilisation de la macro

Bonne soiree

4test.xlsx (40.63 Ko)
Le 16/10/2019 à 00:42

Il faut dire, que quand tout n'est pas défini dès la base, il est plus compliqué de penser à long terme.

Voici un bout de code qui je l'espère va s'adapter au fur et à mesure que les X lignes vont s'allongés ou réduires.

Sub Macro11()

'Création de la feuille "Tempo"
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "Tempo"

'Déclaration de variables Mod1
Dim DLD As Long, DLF As Long
DLD = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
DLF = Sheets("Sheet1").Range("F" & Rows.Count).End(xlUp).Row

'Création TCD Rapport 1

    Range("C1").Select
    Selection.CurrentRegion.Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Sheets("Sheet1").Range("$C$1:$D$" & DLD), Version:=6).CreatePivotTable TableDestination:= _
        "Tempo!R1C2", TableName:="Tableau croisé dynamique3", DefaultVersion:=6
    Sheets("Tempo").Select
    Cells(1, 2).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique3")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique3").RepeatAllLabels _
        xlRepeatLabels
    ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique3").PivotFields("unites"), _
        "Somme de unites", xlSum
    With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
        "Rapport1")
        .Orientation = xlRowField
        .Position = 1
    End With
    Range("B1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'Création du TCD 2

    Sheets("Sheet1").Select
    Range("F1").Select
    Selection.CurrentRegion.Select
    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Sheets("Sheet1").Range("$F$1:$G$" & DLF), Version:=6).CreatePivotTable TableDestination:= _
        "Tempo!R1C6", TableName:="Tableau croisé dynamique4", DefaultVersion:=6
    Sheets("Tempo").Select
    Cells(1, 6).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique4")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique4").RepeatAllLabels _
        xlRepeatLabels
    ActiveSheet.PivotTables("Tableau croisé dynamique4").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique4").PivotFields("unites"), _
        "Somme de unites", xlSum
    With ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotFields( _
        "Rapport2")
        .Orientation = xlRowField
        .Position = 1
    End With
    Selection.CurrentRegion.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'Déclaration de variables Mod2
Dim DLC As Long, DLG As Long

DLC = Sheets("Tempo").Range("C" & Rows.Count).End(xlUp).Row
DLG = Sheets("Tempo").Range("G" & Rows.Count).End(xlUp).Row

'Renommage des tableaux

    'Sheets("Tempo").Active
    Range("B1").FormulaR1C1 = "Rapport-1"
    Range("C1").FormulaR1C1 = "Unités"
    Range("D1").Select
    Range("D1").FormulaR1C1 = "Ecart RP1 vs RP2"
    Range("D2").Select
    Range("D2").FormulaR1C1 = "=SUMIF(C[-2],R[]C[-2],C[-1])-SUMIF(C[2],R[]C[-2],C[3])"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & DLC)

    Range("F1").FormulaR1C1 = "Rapport-2"
    Range("G1").FormulaR1C1 = "Unités"
    Range("H1").Select
    Range("H1").FormulaR1C1 = "Ecart RP2 vs RP1"
    Range("H2").Select
    Range("H2").FormulaR1C1 = "=SUMIF(C[-2],R[]C[-2],C[-1])-SUMIF(C[-6],R[]C[-2],C[-5])"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H" & DLG)
'**

    Range("B1").Select

End Sub

Avec le fichier en exemple.

5test.zip (36.30 Ko)
Rechercher des sujets similaires à "creation macro regroupement donnees deux rapports differents"