Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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
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
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
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
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
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

    Application.CutCopyMode = False

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
883
oguruma
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
681
MarineU
M
Z
  • Question Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
471
zendb
Z
V
  • Question Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
696
Valter
V
M
  • Résolu(e)
XL 2013 Macro qui compare deux tableaux et supprime des lignes selon un critère.
Réponses
4
Affichages
538
manu49300
M
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
571
marie3107
M
W
  • Question Question
XL 2021 Boucle copier-coller par nom d'en-tête de colonnes
Réponses
10
Affichages
767
whiteshark
W
K
  • Question Question
Microsoft 365 VBA - Confusion dans la macro
Réponses
2
Affichages
521
C'est papy Mougeot !
C
  • Résolu(e)
Microsoft 365 Macro copié collé valeur se trouvant dans d'autres feuilles
2 3
Réponses
38
Affichages
2 K
Croc_de_loups
C
I
  • Question Question
XL 2016 Copier coller entre deux classeurs
Réponses
13
Affichages
957
INFINITY100
I
O
  • Question Question
XL 2010 suppression fichiers excel vba
Réponses
9
Affichages
685
Oneida
M
  • Question Question
XL 2016 Envoi courriel copier/coller avec mise en forme (corps couuriel)
Réponses
2
Affichages
2 K
MONTREAL2020
M
J
  • Question Question
Microsoft 365 Macro excel spécifier chemin de sauvegarde one drive
Réponses
4
Affichages
913
.jakob@gmail.com
J
N
  • Question Question
XL 2021 BESOIN D'aide macro
Réponses
7
Affichages
1 K
Gégé-45550
A
  • Question Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
2 K
Arnaud Legay
A
  • Résolu(e)
XL 2019 alléger code VBA (supprimer activate / select / copy / activate / select / paste)
Réponses
4
Affichages
2 K
Eric 888
  • Résolu(e)
Microsoft 365 Macro import
Réponses
13
Affichages
702
looky62
L
  • Résolu(e)
XL 2016 VBA : Copier des valeurs entre deux fichiers
Réponses
4
Affichages
911
Leché
L
D
  • Question Question
XL 2016 Button copier coller cellules indépendantes VBA autre feuille
Réponses
7
Affichages
1 K
vgendron
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
952
fanfan38
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…