Microsoft 365 Macro copier/coller entre deux tableaux structurés

NONO14 · Samedi à 17:50

Bonjour à toutes et à tous,
Dans une feuille de calcul j'ai un premier TS qui est nommé t_Recap et qui est la source des données.
Dans une deuxième feuille j'ai un deuxième TS qui est nommé t_Import et qui est la destination.

t_Import comporte moins de colonnes que t_Recap, ils ont en communs les colonnes suivantes :

t_Recap (A) = t_Import (A) - Code agent
t_Recap (B) = t_Import (B) - NOM Prénom
t_Recap (C) = t_Import (C) - Date
t_Recap (J) = t_Import (D) - Total heures matin
t_Recap (K) = t_Import (E) - Total heures après-midi
t_Recap (L) = t_Import (F) - Total heures soir
t_Recap (M) = t_Import (G) - Total heures jour
t_Recap (N) = t_Import (H) - Total heures Sup
t_Recap (O) = t_Import (I) - Nbre de plages
t_Recap (P) = t_Import (J) - Commentaires

J'ai fait la macro suivante avec l'enregistreur de macros mais elle ne fonctionne que pour la ligne 2.
Ce que je souhaite mettre en place avec votre aide, c'est une macro qui me copie à partit du TS source et colle les données dans le TS destination à partir de la ligne 2 et jusqu'à la fin du TS et seulement les colonnes définies ci-dessus.
Pourriez-vous m'aider à mettre ça en place s'il vous plaît ?
Je vous en remercie par avance

Ensuite, je mettrai en place un code pour imprimer le TS t_Import.

VB:

Sub CopierColler()
'
' CopierColler Macro
   
    Range("A2:C2,J2:P2").Select
    Range("t_Recap[TOTAL Heures matin]").Activate
    Selection.Copy
    Sheets("Imp_Pointage").Select
    Range("t_Import[Code agent]").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

job75 · Dimanche à 15:23

job75 à dit:
Cette macro est très simple :

VB:

Sub CopierColler() If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete Intersect([t_Recap], [t_Recap].Parent.Range("A:C,J:P")).Copy [t_Import].Cells(1) End Sub

On constate que les formules sont remplacées par leurs valeurs.

Et alors ?

job75 · Hier à 00:07

Pas le sujet ? Tu as pourtant écrit :

TooFatBoy à dit:
Je viens de tester en déplaçant, sur leurs feuilles respectives, les deux TS et effectivement ça donne n'imp'.

Bonne nuit.

TooFatBoy · Hier à 00:12

Le sujet était celui-ci :

TooFatBoy à dit:
Dans ce cas, il me semble que du coup la macro de @job75 convient. Me trompé-je ?

Phil69970 à dit:
Si son code est le code de la version 15b du post #
Et bien non il ne correspond pas à un code totalement fait pour un TS

TooFatBoy à dit:
Je parlais du code de @job75 en #21

Et le test que j'ai fait en déplaçant le TS source m'a donné n'importe quoi dans le TS cible, contrairement à ce que je pensais.

job75 · Hier à 07:52

Bonjour le forum,

@TooFatBoy je pense que tu n'as pas bien compris mes solutions.

Dans la macro des posts #18 ou #21 "A:C,J: P" concerne les colonnes de la feuille de calcul, elles sont fixes et on ne peut donc pas déplacer le tableau [t_Recap].

Au post #40 "A:C" et "J: P" représentent toujours les 3 premières et 7 dernières colonnes du tableau, elles suivent le tableau quand on le déplace.

Il suffit de tester.

A+

NONO14 · Hier à 08:59

Bonjour à toutes et à tous,
Je vois que mon sujet a fait débat, très instructif, mais un peu complexe à comprendre pour moi, il y a sans doute une subtilité que je ne saisi pas.
La solution apportée me convient tout à fait et comme je l'ai déjà écrit, les tableaux ne sont pas voués à être déplacés. Les feuilles seront protégées et uniquement déprotégées pendant l'exécution du code et ce sera transparent pour l'utilisateur, donc de ce fait, le seul qui pourrait un changement, ce sera l'administrateur.
Cependant, une question demeure (voir post #26) concernant la 2ème clé de tri que je ne sais pas comment ajouter. Dois-je la mettre en bout de ligne à la suite de la 1ère ou créer une autre ligne de code ?
Merci par avance pour vos propositions

NONO14 · Hier à 09:48

J'ai trouvé une solution avec cette fonction créée par Philippe Tulliez que je remercie pour sa contribution.

VB:

'Fonction créée par Philippe Tulliez (www.magicoffice.be)

Function SortTable(oList As ListObject, Optional LabelList As String)
'Fonction de tri pour ListObject.
'Tri ascendant ou descendant de colonne(s) d'un tableau structuré.
'oList = ListObjet (Objet de la table).
'LabelList = String (Nom des étiquettes de colonne ou leur numéro à trier, séparé par un ";" (sans les guillemets) - Exemple : Voiture;Logement
'Si l'étiquette est précédée par un signe négatif, le tri est descendant - Exemple : -Voiture; -Logement
'Cela siginifie que les colonnes "Voiture et Logement" seront triées dans l'ordre décroissant.
'Si le LabelList est vide, le tri se fait sur la 1ère colonne de la table.

'Les déclarations et affectations
Dim Sc As Range 'La colonne à trier
Dim So As Byte 'Ordre de tri
Dim Sl As Variant 'Liste des champs à trier
Dim El As Integer 'Variable de la boucle
Dim Value As Variant

'Liste des champs à trier suivant l'argument [LabelList], si vide, l'Array prend l'étiquette de la 1ère colonne
    Sl = IIf(Len(LabelList), Split(LabelList, ";"), Array(oList.ListColumns(1).Name))
   
        With oList
            .Sort.SortFields.Clear
                For El = LBound(Sl) To UBound(Sl)
                    So = 1 + Abs(Left(Sl(El), 1) = "-")
                        Value = Mid(Sl(El), So): If IsNumeric(Value) Then Value = Val(Value)
                        Set Sc = .ListColumns(Value).DataBodyRange
                                        .Sort.SortFields.Add Key:=Sc, SortOn:=xlSortOnValues, Order:=So
                Next
                    .Sort.Apply
    End With
   
Set Sc = Nothing
End Function

job75 · Hier à 12:08

Bonjour NONO14, le fil,

Dans votre dernier fichier il y a plusieurs lignes dans le tableau [t_Import], Il est peut-être nécessaire de supprimer cette ligne superflue :

VB:

If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete

Quant au tri je suppose qu'il se fait d'abord sur la colonne C (Date) puis sur la colonne B (NOM Prénom).

Vous pouvez donc utiliser cette macro :

VB:

Sub CopierColler()
'If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete
With [t_Recap]
    If Application.CountIf(.Rows(1), "><") + Application.Count(.Rows(1)) = 0 Then Exit Sub 'si aucune donnée à transférer
    Union(.Columns("A:C"), .Columns("J:P")).Copy [t_Import].Cells([t_Import].Rows.Count + IIf(Application.CountA([t_Import]), 1, 0), 1)
    .Delete
End With
With [t_Import]
    .ListObject.Range.Sort .Columns(3), xlAscending, , .Columns(2), xlAscending, Header:=xlYes 'tri sur 2 colonnes
    .Font.Size = 10
    .EntireColumn.AutoFit 'ajustement largeurs
    .Parent.Activate
End With
End Sub

A+

NONO14 · Hier à 12:16

job75 à dit:
Bonjour NONO14, le fil,

Dans votre dernier fichier il y a plusieurs lignes dans le tableau [t_Import], Il est peut-être nécessaire de supprimer cette ligne superflue :

VB:

If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete

Quant au tri je suppose qu'il se fait d'abord sur la colonne C (Date) puis sur la colonne B (NOM Prénom).

Vous pouvez donc utiliser cette macro :

VB:

Sub CopierColler() 'If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete With [t_Recap] If Application.CountIf(.Rows(1), "><") + Application.Count(.Rows(1)) = 0 Then Exit Sub 'si aucune donnée à transférer Union(.Columns("A:C"), .Columns("J:P")).Copy [t_Import].Cells([t_Import].Rows.Count + IIf(Application.CountA([t_Import]), 1, 0), 1) .Delete End With With [t_Import] .ListObject.Range.Sort .Columns(3), xlAscending, , .Columns(2), xlAscending, Header:=xlYes 'tri sur 2 colonnes .Font.Size = 10 .EntireColumn.AutoFit 'ajustement largeurs .Parent.Activate End With End Sub

A+

Bonjour job75,
Merci pour votre participation. Le tri ce fait d'abord sur le Code agent et ensuite sur la date. Mais j'avais trouvé une solution que j'ai notifié dans le post #50 juste au-dessus.
Pourquoi faut-il que je supprime la ligne indiquée ? Ne sert-elle pas à effacer les données du tableau destinataire avant le collage des nouvelles données ?
Cependant, merci encore pour votre aide.

chris · Hier à 13:07

Bonjour à tous

Un tableau peut être remanié, déplacé même dans une autre feuille. Donc tant que les titres de colonnes ne changent pas il n'est pas nécessaire de modifier le code
Adaptation du code de mapomme

VB:

Sub RecapVersIMP_Pointage()
Dim tsrecap As ListObject, x As ListColumn, i&
   Application.ScreenUpdating = False
   Set tsrecap = Range("t_Recap").ListObject
   With Range("t_Import").ListObject
      If Not .DataBodyRange Is Nothing Then .DataBodyRange.EntireRow.Delete
      For Each CS In tsrecap.ListColumns
        CN = CS.Name
        CS.DataBodyRange.Copy
        On Error Resume Next
        .ListColumns(CN).Range.Cells(2, 1).PasteSpecial xlPasteValues
        On Error GoTo 0
    Next CS
   End With
End Sub

On peut y ajouter le tri mais il est totalement inutile de toucher à la mise en forme : la tableau même vidé gardant les réglages (et formules le cas échéant) donc avec tout

Code:

Sub RecapVersIMP_Pointage()
Dim tsrecap As ListObject, x As ListColumn, i&
   Application.ScreenUpdating = False
   Set tsrecap = Range("t_Recap").ListObject
   With Range("t_Import").ListObject
      If Not .DataBodyRange Is Nothing Then .DataBodyRange.EntireRow.Delete
      For Each CS In tsrecap.ListColumns
        CN = CS.Name
        CS.DataBodyRange.Copy
        On Error Resume Next
        .ListColumns(CN).Range.Cells(2, 1).PasteSpecial xlPasteValues
        On Error GoTo 0
    Next CS
 
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=Range("t_Import[Date]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add2 Key:=Range("t_Import[Code agent]"), SortOn:=xlSortOnValues, _
         Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With

   End With
End Sub

EDIT : on peut inverser l'ordre de tri si j'ai mal compris

NONO14 · Hier à 13:15

chris à dit:

Bonjour à tous

Un tableau peut être remanié, déplacé même dans une autre feuille. Donc tant que les titres de colonnes ne change pas il n'est pas nécessaire de modifier le code
Adaptation du code de mapomme

VB:

Sub RecapVersIMP_Pointage()
Dim tsrecap As ListObject, x As ListColumn, i&
   Application.ScreenUpdating = False
   Set tsrecap = Range("t_Recap").ListObject
   With Range("t_Import").ListObject
      If Not .DataBodyRange Is Nothing Then .DataBodyRange.EntireRow.Delete
      For Each CS In tsrecap.ListColumns
        CN = CS.Name
        CS.DataBodyRange.Copy
        On Error Resume Next
        .ListColumns(CN).Range.Cells(2, 1).PasteSpecial xlPasteValues
        On Error GoTo 0
    Next CS
   End With
End Sub

On peut y ajouter le tri mais il est totalement inutile de toucher à la mise en forme : la tableau même vidé gardant les réglages (et formules le cas échéant) donc avec tout

Code:

Sub RecapVersIMP_Pointage()
Dim tsrecap As ListObject, x As ListColumn, i&
   Application.ScreenUpdating = False
   Set tsrecap = Range("t_Recap").ListObject
   With Range("t_Import").ListObject
      If Not .DataBodyRange Is Nothing Then .DataBodyRange.EntireRow.Delete
      For Each CS In tsrecap.ListColumns
        CN = CS.Name
        CS.DataBodyRange.Copy
        On Error Resume Next
        .ListColumns(CN).Range.Cells(2, 1).PasteSpecial xlPasteValues
        On Error GoTo 0
    Next CS
 
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=Range("t_Import[Date]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add2 Key:=Range("t_Import[Code agent]"), SortOn:=xlSortOnValues, _
         Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With

   End With
End Sub

EDIT : on peut inverser l'ordre de tri si j'ai mal compris

Bonjour chris,
Merci pour vos précisions. Le code de Philippe Tulliez me donnant entière satisfaction, je vais le conserver.
Cependant, je garde votre idée sous le coude pour une prochaine fois.
Encore merci pour le code

TooFatBoy · Hier à 13:19

job75 à dit:
@TooFatBoy je pense que tu n'as pas bien compris mes solutions.

Je pense que tu n'as pas exactement compris ce que j'ai écrit puisque, encore une fois, il n'était absolument pas question de #40 mais seulement de #21.

Toutefois tu as bien compris mon interrogation de #38 où je demandais si #21 fonctionnait quelle que soit la position de la source, demandant ainsi si A:C faisait référence au TS ou à la feuille.

Quant à faire un test, comme je l'ai dit, je l'ai déjà effectué et en déplaçant le TS source ça donne n'importe quoi dans le TS cible.

Merci pour ton aide.

job75 · Hier à 13:20

NONO14 à dit:
Pourquoi faut-il que je supprime la ligne indiquée ? Ne sert-elle pas à effacer les données du tableau destinataire avant le collage des nouvelles données ?

Je proposais de coller les nouvelles données sous les précédentes mais on peut bien sûr utiliser :

VB:

Sub CopierColler()
If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete
With [t_Recap]
    If Application.CountIf(.Rows(1), "><") + Application.Count(.Rows(1)) = 0 Then Exit Sub 'si aucune donnée à transférer
    Union(.Columns("A:C"), .Columns("J:P")).Copy [t_Import].Cells(1)
    .Delete
End With
With [t_Import]
    .ListObject.Range.Sort .Columns(1), xlAscending, , .Columns(3), xlAscending, Header:=xlYes 'tri sur 2 colonnes
    .Font.Size = 10
    .EntireColumn.AutoFit 'ajustement largeurs
    .Parent.Activate
End With
End Sub

Le tri que j'utilise est plus simple que celui du post #50.

TooFatBoy · Hier à 13:21

NONO14 à dit:
Je vois que mon sujet a fait débat, très instructif, mais un peu complexe à comprendre pour moi, il y a sans doute une subtilité que je ne saisi pas.

Oui, et pour moi également !

NONO14 · Hier à 13:25

job75 à dit:

Je proposais de coller les nouvelles données sous les précédentes mais on peut bien sûr utiliser :

VB:

Sub CopierColler()
If Not [t_Import].ListObject.DataBodyRange Is Nothing Then [t_Import].Delete
With [t_Recap]
    If Application.CountIf(.Rows(1), "><") + Application.Count(.Rows(1)) = 0 Then Exit Sub 'si aucune donnée à transférer
    Union(.Columns("A:C"), .Columns("J:P")).Copy [t_Import].Cells(1)
    .Delete
End With
With [t_Import]
    .ListObject.Range.Sort .Columns(1), xlAscending, , .Columns(3), xlAscending, Header:=xlYes 'tri sur 2 colonnes
    .Font.Size = 10
    .EntireColumn.AutoFit 'ajustement largeurs
    .Parent.Activate
End With
End Sub

Le tri que j'utilise est plus simple que celui du post #50.

D'accord. Je vais le tester alors.

TooFatBoy · Hier à 13:27

chris à dit:
Un tableau peut être remanié, déplacé même dans une autre feuille. Donc tant que les titres de colonnes ne change pas il n'est pas nécessaire de modifier le code

chris à dit:
On peut y ajouter le tri mais il est totalement inutile de toucher à la mise en forme : la tableau même vidé gardant les réglages (et formules le cas échéant) donc avec tout

Voilà deux réflexions qui vont faire un immense plaisir au moins à Phil et moi-même.

Sur ce, je vous souhaite une excellente semaine.

job75 · Hier à 13:27

TooFatBoy à dit:
Quand à faire un test, comme je l'ai dit, je l'ai déjà effectué et en déplaçant le TS source ça donne n'importe quoi dans le TS cible.

Bah si tu testes la macro du post #40, comme je l'ai dit aucun problème si tu déplaces le tableau.

Microsoft 365 Macro copier/coller entre deux tableaux structurés

NONO14

XLDnaute Occasionnel

job75

job75

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

NONO14

XLDnaute Occasionnel

NONO14

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

NONO14

XLDnaute Occasionnel

chris

XLDnaute Barbatruc

NONO14

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires