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
 

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 ?
 

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
 

NONO14

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

mapomme

XLDnaute Barbatruc
Supporter XLD
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:

TooFatBoy

XLDnaute Barbatruc
Hopla !

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

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:

NONO14

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

NONO14

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

Discussions similaires

Réponses
23
Affichages
772

Membres actuellement en ligne

Statistiques des forums

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