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

N

NONO14

XLDnaute Impliqué
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
 
Trier par date Trier par votes
chris

chris

XLDnaute Barbatruc
Bonjour
On ne traite pas un tableau structuré comme une plage et la boucle est totalement inutile

Il faut copier les colonnes entières du tableau (pas d'Excel) en plusieurs fois puisqu'elles ne sont pas consécutives (2 fois à priori)

La tableau cible est vide ?
 
Vote positif 0 Vote négatif
F

Franc58

XLDnaute Occasionnel
Salut à tous, voici une suggestion qui pourra servir de base de travail.

VB: 
Sub CopierCollerTS()
    Dim wsRecap As Worksheet
    Dim wsImport As Worksheet
    Dim tRecap As ListObject
    Dim tImport As ListObject
    Dim i As Long
    Dim tableauDonnees() As Variant
    Dim lignes As Long
    
    Set wsRecap = ThisWorkbook.Sheets("t_Recap")
    Set wsImport = ThisWorkbook.Sheets("t_Import")
    
    Set tRecap = wsRecap.ListObjects("t_Recap")
    Set tImport = wsImport.ListObjects("t_Import")
    
    ' Vérifier si le tableau source contient des données
    If tRecap.DataBodyRange Is Nothing Then
        MsgBox "Le tableau t_Recap ne contient pas de données.", vbExclamation
        Exit Sub
    End If
    
    ' Définir la taille du tableau en fonction du nombre de lignes du tableau source
    lignes = tRecap.DataBodyRange.Rows.Count
    ReDim tableauDonnees(1 To lignes, 1 To 10) ' 10 colonnes à copier

    ' Charger les données de t_Recap dans le tableau
    For i = 1 To lignes
        tableauDonnees(i, 1) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Code agent").Index).Value
        tableauDonnees(i, 2) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("NOM Prénom").Index).Value
        tableauDonnees(i, 3) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Date").Index).Value
        tableauDonnees(i, 4) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Total heures matin").Index).Value
        tableauDonnees(i, 5) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Total heures après-midi").Index).Value
        tableauDonnees(i, 6) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Total heures soir").Index).Value
        tableauDonnees(i, 7) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Total heures jour").Index).Value
        tableauDonnees(i, 8) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Total heures Sup").Index).Value
        tableauDonnees(i, 9) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Nbre de plages").Index).Value
        tableauDonnees(i, 10) = tRecap.DataBodyRange.Cells(i, tRecap.ListColumns("Commentaires").Index).Value
    Next i
    
    If tImport.DataBodyRange Is Nothing Then
        ' Si t_Import est vide, ajouter la première ligne avant de redimensionner
        tImport.ListRows.Add
    End If
    
    ' Coller les données dans t_Import en redimensionnant correctement le tableau
    tImport.DataBodyRange.Resize(lignes, 10).Value = tableauDonnees
    
    MsgBox "Les données ont été copiées avec succès à partir de t_Recap vers t_Import !", vbInformation
    
End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
chris à dit:
Bonjour
On ne traite pas un tableau structuré comme une plage et la boucle est totalement inutile

Il faut copier les colonnes entières du tableau (pas d'Excel) en plusieurs fois puisqu'elles ne sont pas consécutives (2 fois à priori)

La tableau cible est vide ?
Cliquez pour agrandir...
Bonsoir chris,
Merci pour ta réponse. Oui le fichier cible est vide, et à chaque fois que l'on copiera des données, il faut également écraser les anciennes données.
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Bonsoir à tous :),
@NONO14 : Merci pour le classeur .👌

Un autre code qui ne se base que sur les titres des colonnes. L'ordre des colonnes n'a donc pas d'importance :
VB: 
Sub RecapVersIMP_Pointage()
Dim tsrecap As ListObject, x As ListColumn, i&
   Application.ScreenUpdating = False
   Set tsrecap = Sheets("Recap").[a1].ListObject
   With Sheets("Imp_Pointage").[a1].ListObject
      .DataBodyRange.EntireRow.Delete
      For Each x In .ListColumns
         On Error Resume Next
         i = 0: i = Application.Match(x.Range(1, 1), tsrecap.HeaderRowRange, 0)
         On Error GoTo 0
         If i > 0 Then tsrecap.ListColumns(i).Range.Copy x.Range
      Next x
   End With
End Sub


Si vous désirez ne copier que les valeurs, alors remplacer :
VB: 
If i > 0 Then tsrecap.ListColumns(i).Range.Copy x.Range
par :
VB: 
If i > 0 Then tsrecap.ListColumns(i).Range.Copy: x.Range.PasteSpecial xlPasteValues
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Hopla !

NONO14 à dit:
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
Cliquez pour agrandir...

Une proposition (une de plus... ) :
VB: 
Sub CopieTSaTS()
'
Dim ts_S As ListObject, ts_C As ListObject
Dim Titre As String
Dim Colonne As Range

    Application.ScreenUpdating = False

    Set ts_S = Range("t_Recap").ListObject
    Set ts_C = Range("t_Import").ListObject

    ' Suppression de toutes les lignes de données du TS cible s'il n'est pas vide
    With ts_C
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With

    ' Ajout d'une ligne au TS cible
    ts_C.ListRows.Add

    ' Copie des données, colonne par colonne, en fonction des colonnes du TS cible
    For Each Colonne In ts_C.HeaderRowRange.Cells
        Titre = Colonne.Value
        ts_S.ListColumns(Titre).DataBodyRange.Copy
        ts_C.ListColumns(Titre).DataBodyRange.Cells(1, 1).PasteSpecial xlPasteValues
    Next Colonne

    Application.CutCopyMode = False

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Hopla !



Une proposition (une de plus... ) :
VB: 
Sub CopieTSaTS()
'
Dim ts_S As ListObject, ts_C As ListObject
Dim Titre As String
Dim Colonne As Range

    Application.ScreenUpdating = False

    Set ts_S = Range("t_Recap").ListObject
    Set ts_C = Range("t_Import").ListObject

    ' Suppression de toutes les lignes de données du TS cible s'il n'est pas vide
    With ts_C
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With

    ' Ajout d'une ligne au TS cible
    ts_C.ListRows.Add

    ' Copie des données, colonne par colonne, en fonction des colonnes du TS cible
    For Each Colonne In ts_C.HeaderRowRange.Cells
        Titre = Colonne.Value
        ts_S.ListColumns(Titre).DataBodyRange.Copy
        ts_C.ListColumns(Titre).DataBodyRange.Cells(1, 1).PasteSpecial xlPasteValues
    Next Colonne

End Sub
Cliquez pour agrandir...
Bonjour TootFatBoy,

Ton code fonctionne bien, cependant il y a un petit tracas. Après la copie des données, la colonne "Commentaire" de la feuille "Recap" (t_Recap) reste sélectionné, je suis obligé d'appuyer sur "Echap" du clavier pour la désélectionner. Comment éviter ça ?
J'ai également ajouté une MsgBox de confirmation. La macro se déclenche après avoir cliqué sur le bouton "Administration" de la feuille "Saisie" (MdP =admin01) et dans le menu déroulant choisir "Editer les pointages". Le code se trouve dans le module mFunctions.
Merci par avance

VB: 
Sub Copier_Valeurs()
Dim ts_S As ListObject, ts_C As ListObject
Dim Titre As String
Dim Colonne As Range

    Application.ScreenUpdating = False

    Set ts_S = Range("t_Recap").ListObject
    Set ts_C = Range("t_Import").ListObject

If MsgBox("Etes-vous certain de vouloir copier les pointages ?", vbYesNo, "Demande de confirmation") = vbYes Then
    
    ' Suppression de toutes les lignes de données du TS cible s'il n'est pas vide
    With ts_C
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With

    ' Ajout d'une ligne au TS cible
    ts_C.ListRows.Add

    ' Copie des données, colonne par colonne, en fonction des colonnes du TS cible
    For Each Colonne In ts_C.HeaderRowRange.Cells
        Titre = Colonne.Value
        ts_S.ListColumns(Titre).DataBodyRange.Copy
        ts_C.ListColumns(Titre).DataBodyRange.Cells(1, 1).PasteSpecial xlPasteValues
    Next Colonne
    
    MsgBox "Le transfert s'est bien déroulé", vbInformation, "Copie données"
    
    Sheets("Saisie").Activate

Else
    Sheets("Saisie").Activate

End If
 

Pièces jointes

  • PointHeure15.xlsm
    785 KB · Affichages: 1
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
J'ai trouvé la solution en ajoutant "Application.CutCopyMode=False" après le collage.
C'était tout bête....
Merci encore à toutes et à tous pour votre aide
VB: 
    For Each Colonne In ts_C.HeaderRowRange.Cells
        Titre = Colonne.Value
        ts_S.ListColumns(Titre).DataBodyRange.Copy
        ts_C.ListColumns(Titre).DataBodyRange.Cells(1, 1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 Copier Coller selon condition
Réponses
5
Affichages
223
TooFatBoy
TooFatBoy
jeff1494
  • Question
XL 2021 [Résolu] MFC et tableau structuré
Réponses
14
Affichages
301
jeff1494
jeff1494
S
  • Question
Autres liste déroulante dynamique à 2 niveaux
Réponses
2
Affichages
104
saralht
S
A
  • Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
161
Anthony_51
A
A
  • Résolu(e)
Microsoft 365 Référence automatique de tableaux structurés
Réponses
12
Affichages
880
AlexiaC
A
M
  • Résolu(e)
XL 2013 Macross supprimant les données de cellule en dehors d'une période définie dans deux autres cellules
Réponses
9
Affichages
540
MarineU
M
Z
  • Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
303
zendb
Z
D
  • Résolu(e)
XL 2019 Report automatique de données
2
Réponses
17
Affichages
1 K
AtTheOne
AtTheOne
V
  • Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
549
Valter
V
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
372
CathyLD
C

Membres actuellement en ligne

17 membres et 214 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 118
Messages
2 116 421
Membres
112 745
dernier inscrit
mcanas