Microsoft 365 Copier les données d'un tableau vers un autre

[bluesky12000]

Bonsoir à tous,

Je cherche à copier les données de mon tableau 1 vers mon tableau 2 en insérant toutes les données à la fin du tableau 2.
Je supprime ensuite toutes les données de mon tableau 1.

J'ai créé ce code, tout à l'air de fonctionner à part que les données viennent en première ligne de mon tableau 2 et efface donc les données déjà existantes.
Comment insérer les données dans la première ligne vide de mon tableau?

Merci beaucoup

Dim ws As Worksheet
Dim tA As Range
Dim tB As Range
Dim i As Integer
Dim y As Integer

Set ws = ActiveSheet

' Définir les tableaux
Set tA = ws.ListObjects(1).DataBodyRange
Set tB = ws.ListObjects(2).DataBodyRange

'compter le nombre de lignes dans le tableau 1
i = tA.Rows.Count

'créer une ligne dans le tableau 2 pour chaque ligne du tableau 1
For y = 1 To i
ws.ListObjects(2).ListRows.Add
Next y

'copier le tableau 1 dans le tableau 2
tA.Copy tB

' réduire à une ligne le tableau 1
With tA
    If .Rows.Count > 1 Then
      .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
    End If

End With

' effacer la première ligne du tableau 1 mais garder les formules
tA.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents

End Sub

 

[cp4]

Bonsoir,

sans fichier pour tester, moi je trouve des difficulté à aider. Mister Google m'a fourni un exemple Lien

 

[bluesky12000]

Bonsoir cp4,

Merci pour votre aide, voici mon tableau.
Plutôt que de conserver les données du tableau de destination je cherche maintenant à les supprimer avant d'insérer le contenu du tableau source

J'ai plusieurs soucis :
1 ) Si le tableau de destination est vide il y a une erreur pour copier le contenu.
2 ) Si le tableau de destination a du contenu alors toutes les lignes sont remplacées par celles du tableau source même si le tableau source n'a pas autant de ligne.

Merci beaucoup

 

[cp4]

Re, je t'avoue que je suis déboussolé.
En effet, tu nous parles de 2 tableaux alors que dans ton fichier joint il y en a 6.
Pourrai-tu être plus explicite?

 

[bluesky12000]

Re, je t'avoue que je suis déboussolé.
En effet, tu nous parles de 2 tableaux alors que dans ton fichier joint il y en a 6.
Pourrai-tu être plus explicite?

En fait dans mon vrai fichier j'ai 8 tableaux, je veux transférer les données du 7 dans le 8, du 6 dans le 7, du 5 dans le 6 etc, c'est pour cela que j'ai une variable liée au nombre dans le nom du tableau.

Pour mon fichier d'exemple les 3 tableaux sur le côté sont justes la pour éviter de devoir recopier toutes les valeurs et les formules en cas de pépin

 

[cp4]

Bonjour,

Pas du tout astucieux ton idée d'utiliser un inputbox. Il faut aussi gérer les erreurs de saisies (lettre au lieu de chiffre, et risque de se tromper de tableau de destination ou l'inverse).

Je te signale que le copier/coller du DataBodyRange transmet aussi les formules du tableau source.
Du coup, si le tableau de destination n'est pas vide, le résultat est #Valeurs. Tu vas le constater.
voir fichier en retour.

 

[bluesky12000]

Merci, cp4, d'avoir pris le temps de travailler sur ma question.

Si je veux d'abord supprimer le contenu du tableau de destination comment puis-je faire sans avoir d'erreur?

Du coup est-ce qu'il est possible de copier toutes les valeurs du DataBodyRange sans les formules ?
Le souci est que les formules gardent le nom du tableau dans leurs références structurées alors que de base j'ai bien les mêmes formules puisque tous mes tableaux sont identiques.

Merci beaucoup,

 

[cp4]

Merci, cp4, d'avoir pris le temps de travailler sur ma question.

Si je veux d'abord supprimer le contenu du tableau de destination comment puis-je faire sans avoir d'erreur?

Du coup est-ce qu'il est possible de copier toutes les valeurs du DataBodyRange sans les formules ?
Le souci est que les formules gardent le nom du tableau dans leurs références structurées alors que de base j'ai bien les mêmes formules puisque tous mes tableaux sont identiques.

Merci beaucoup,

Bonsoir,

Pour effacer tableau de destination au préalable voici le code complété

Sub Test()

    Dim ws As Worksheet, tA As ListObject, tB As ListObject
    Dim t1 As Variant, t2 As Variant
    Dim i As Integer, y As Integer
    Dim lig As ListRow
    Set ws = ActiveSheet

    Set tA = ws.ListObjects("Table1")
    Set tB = ws.ListObjects("Table2")
    '-------------------------------------
    'Suprimer le contenu du tableau B mais garder les formules
    If Not tB Is Nothing Then
        On Error Resume Next
        tB.DataBodyRange.Delete
        On Error GoTo 0
    End If

    Set lig = tB.ListRows.Add
    'même les formules sont transmises d'où erreur lorsque tB n'est pas vide
    tA.DataBodyRange.Copy lig.Range.Cells(1)

    'Suprimer le contenu du tableau A mais garder les formules
    If Not tA Is Nothing Then
        On Error Resume Next
        tA.DataBodyRange.Delete
        On Error GoTo 0
    End If
    MsgBox "Transfert terminé!"
End Sub

Pour ce qui est des formules, je ne sais au juste. Si je trouve une solution, je la partagerai.

Bonne soirée.

 

[bluesky12000]

Merci cp4,

Le code fonctionne très bien mais j'ai l'impression qu'il oublie d'ajouter le bon nombre de ligne au tableau avant de coller les données. Ce qui fait qu'un tableau peut empiéter sur un autre.

A quoi sert cette partie, je ne comprends pas très bien ?

Set lig = tB.ListRows.Add
    'même les formules sont transmises d'où erreur lorsque tB n'est pas vide
    tA.DataBodyRange.Copy lig.Range.Cells(1)

 

[cp4]

Set lig = tB.ListRows.Add 'ajoute une ligne en fin de tableau et récupère dans la variable Lig n° de ligne dans le tableau'
    'même les formules sont transmises d'où erreur lorsque tB n'est pas vide
    tA.DataBodyRange.Copy 'copie les données du tableau'
    lig.Range.Cells(1) 'se positionne sur la ligne vide ajoutée 1ere colonne

Possible que je me trompe car je n'ai encore bien intégré toutes les syntaxes de ces fichus ListObjects.

 

[cp4]

Bonjour,

tester cette macro

Option Explicit

Sub BoucleColonnes()

    Dim lc As Long, mc As Variant, x As Variant
    Dim ws As Worksheet
    Dim tA As ListObject, tB As ListObject

    Set ws = Worksheets("sheet1")
    Set tA = ws.ListObjects("table1")
    Set tB = ws.ListObjects("table2")

    With tB
        'vider table2
        On Error Resume Next
        .DataBodyRange.Delete
        .Resize .Range.Resize(tA.ListRows.Count + 1, .ListColumns.Count)
        On Error GoTo 0

        'boucle sur nom des colonnes sauf derniere d'où le (-1)
        For lc = 1 To tA.ListColumns.Count - 1
           mc = Application.Match(.HeaderRowRange(lc), tA.HeaderRowRange, 0)
            If Not IsError(mc) Then
                x = tA.ListColumns(mc).DataBodyRange.Value
                .ListColumns(lc).DataBodyRange = x
            End If
        Next lc
    End With
End Sub

 

[bluesky12000]

Bonjour cp4,

Désolé pour ma réponse tardive. Merci pour ton nouveau code.

J'ai une erreur (Object variable or with block variable not set) avec cette ligne :

.ListColumns(lc).DataBodyRange = x

Est-ce que tout fonctionnait chez toi?

Merci et bon dimanche

 

[cp4]

Bonjour cp4,

Désolé pour ma réponse tardive. Merci pour ton nouveau code.

J'ai une erreur (Object variable or with block variable not set) avec cette ligne :

.ListColumns(lc).DataBodyRange = x

Est-ce que tout fonctionnait chez toi?

Merci et bon dimanche

Bonsoir,

Je viens de tester et ça fonctionne parfaitement.
Si tes tableaux sont identiques à ceux du fichier que tu as joint. Tout devrait fonctionner.
Je t'ai commenté le code.

Option Explicit
Sub BoucleColonnes()

    Dim lc As Long, mc As Variant, x As Variant
    Dim ws As Worksheet
    Dim tA As ListObject, tB As ListObject

    Set ws = Worksheets("sheet1")
    Set tA = ws.ListObjects("table1")
    Set tB = ws.ListObjects("table2")

    With tB
        'vider table2
        On Error Resume Next
        .DataBodyRange.Delete 'suppression des données
        .Resize .Range.Resize(tA.ListRows.Count + 1, .ListColumns.Count) 'redimensionne le tableau tB au nombre de ligne du tableau tA
        On Error GoTo 0

        'boucle sur nom des colonnes sauf derniere d'où le (-1)
        For lc = 1 To tA.ListColumns.Count - 1 'boucle sur les colonnes du tableau tA sauf la dernière d'où le (-1)
           mc = Application.Match(.HeaderRowRange(lc), tA.HeaderRowRange, 0) 'recherche correspondance de entetes
            If Not IsError(mc) Then 'si pas d'erreur
                x = tA.ListColumns(mc).DataBodyRange.Value 'recupere dans array les données de la colonne (mc)
                .ListColumns(lc).DataBodyRange = x ' affectation de l'array x à la colonne (mc)
            End If
        Next lc
    End With
End Sub

edit: le nom de entêtes doivent être identiques