Microsoft 365 Transfert de données entre tableaux (archivage)

[hatem1234]

Bonjour le forum,

J'essaye de créer une macro pour archiver les données d'un Tableau 1 dans un Tableau 2 en ajoutant une date dans la colonne 1 du Tableau 2 et en calculant un total de données

plus facile de comprendre avec le fichier ci-joint

est-ce des idées? ou une piste ?

NB : une solution existe déjà avec l'utilisation d'un TCD mais si c'est possible d'utiliser une macro sans TCD ni l'ajout d'une autre feuille masquée

Merci bcp !

 

[Robert]

Bonjour Hatem, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub ThauTheme()
Dim O As Worksheet 'décalre la variable O (Onglet)
Dim T1 As ListObject 'décalre la variable T1 (Tableau 1)
Dim T2 As ListObject 'décalre la variable T2 (tableau 2)
Dim D1 As Object 'décalre la variable D1 (Dictionnaire 1)
Dim D2 As Object 'décalre la variable D2 (Dictionnaire 2)
Dim I As Integer 'décalre la variable I (Inccrément)
Dim N As Integer 'décalre la variable N (Nombre)
Dim R As Range 'décalre la variable R (Recherche)
Dim LI As Integer 'décalre la variable LI (LIgne)

Set O = Worksheets("Feuil1") 'définit l'onglet O
Set T1 = O.ListObjects("Tableau1") 'définit la tbaleau T1
Set T2 = O.ListObjects("Tableau2") 'définit la tableau T2
Set D1 = CreateObject("Scripting.dictionary") 'définit le dictionnaire D1
Set D2 = CreateObject("Scripting.dictionary") 'définit le dictionnaire D2
For I = 1 To T1.ListRows.Count 'boucle sur toutes les lignes I de T1
    D1(T1.DataBodyRange(I, 1).Value) = D1(T1.DataBodyRange(I, 1).Value) + 1 'alimente le dictionnaire D1
    D2(T1.DataBodyRange(I, 5).Value) = "" 'alimente le dictionnaire D2
Next I 'prochaine ligne de la boucle
N = D1.Count 'définit le nombre d'éléments N du dictionnaire D1
Set R = T2.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de T2
If R Is Nothing Or T2.ListRows.Count = 0 Then 'condition : si aucune occurrence n'est trouvée ou si T2 ne contient pas encore de ligne
    T2.ListRows.Add 'ajoute une ligne à T2
    LI = T2.ListRows.Count 'définit la ligne LI (dernière ligne de T2)
Else 'sinon (au moins une occrrence a été trouvée)
    LI = R.Row - T2.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des en-têtes de T2)
End If 'fin de la condition
T2.Resize T2.Range.Resize(T2.ListRows.Count + N, T2.ListColumns.Count) 'redimensionne T2
T2.DataBodyRange(LI, 1).Resize(N, 1).Value = Date 'renvoie la date dans la donnée ligne LI colonne 1 de T2, redimensionnée
'renvoie la liste des éléments du dictionnaire D1 sans doublons (les clés) dans la donnée ligne LI colonne 2 de T2, redimensionnée
T2.DataBodyRange(LI, 2).Resize(N, 1).Value = Application.Transpose(D1.Keys)
'renvoie la somme de la liste des éléments du dictionnaire D1 sans doublons (les items) dans la donnée ligne LI colonne 4 de T2, redimensionnée,
T2.DataBodyRange(LI, 4).Resize(N, 1).Value = Application.Transpose(D1.Items)
'renvoie la liste des éléments du dictionnaire D2 sans doublons (les clés) dans la donnée ligne LI colonne 3 de T2, redimensionnée,
T2.DataBodyRange(LI, 3).Resize(N, 1).Value = Application.Transpose(D2.Keys)
End Sub

Tu ne dis pas ce que l'on fait des données du Tableau1 après la macro ? Dans l'état actuel si tu cliques deux fois sur le bouton Macro tu répèteras les données dans Tableau2...

 

[hatem1234]

Bonjour Robert,
Ton code fonctionne à merveille et effectivement après le transfert, les données du Tableau 1 doivent y rester
J'ai seulement modifié la ligne suivante car au lieu de la date du jour, la colonne 1 du Tableau 2 doit afficher la date qui se trouve dans la cellule B2
T2.DataBodyRange(LI, 1).Resize(N, 1).Value = O.Range("B2")
Merci aussi pour les commentaires dans le code qui permettent de vraiment tout comprendre. Un travail de PRO
Merci encore