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

NONO14

XLDnaute Occasionnel
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
 

TooFatBoy

XLDnaute Barbatruc
Le sujet était celui-ci :
Dans ce cas, il me semble que du coup la macro de @job75 convient. Me trompé-je ?
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
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.
 
Dernière édition:

job75

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • PointHeure15b.xlsm
    791.8 KB · Affichages: 1

job75

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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
 
Dernière édition:

NONO14

XLDnaute Occasionnel
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

XLDnaute Barbatruc
@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. 👍
 
Dernière édition:

job75

XLDnaute Barbatruc
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.
 

NONO14

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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

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.
 
Dernière édition:

Discussions similaires

Réponses
23
Affichages
775

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
314 121
Messages
2 106 129
Membres
109 495
dernier inscrit
jerome bonneau