XL 2019 Problème copier/coller tableau structuré

[FLOW312020]

Salut à tous,

J'ai besoin d'un petit coup de main pour une ligne qui me pose un sérieux problème actuellement. Le but de la sub est de copier une ligne d'un tableau structuré dans un autre tableau structuré. Chaque tableau est constitué du même nombre de colonnes.
Tout fonctionne parfaitement jusqu'à la ligne ou je demande de coller les valeurs copiées dans le tableau de destination. J'ai un message d'erreur "La methode PasteSpecial" de la classe range a échoué"... je sèche après 1h30 de test et recherche.

Sub Importer(oTableauSource As ListObject, oTableauDestination As ListObject, nLigne As Long)

    Dim oLigneDestination, oLigneSource As ListRow
    Dim PositionLigneSource, PositionLigneDestination As Long
    Dim i, nLigneSource As Long
    
    i = 1
    
    If nLigne = 0 Then
        oTableauSource.DataBodyRange.Copy
        oTableauDestination.DataBodyRange.PasteSpecial (xlPasteValues)
    Else
        For Each oLigneSource In oTableauSource.ListRows
         nLigneSource = oLigneSource.Index
             If nLigneSource <= nLigne Then
                oTableauSource.ListRows(nLigneSource).Range.Copy
                Set oLigneDestination = oTableauDestination.ListRows.Add(i, AlwaysInsert:=True)
                PositionLigneDestination = oLigneDestination.Index
                oTableauDestination.DataBodyRange(PositionLigneDestination).PasteSpecial (xlPasteValues)
                
                i = i + 1
            End If
        Next
    End If

End Sub

Merci pour votre aide

 

[Staple1600]

Bonjour le fil

Avec et selon ce que j'ai compris
1) copie une ligne d'une tableau à la la fin d'un autre

Sub test_Ok()
Importer Feuil2.ListObjects(1), Feuil3.ListObjects(1), 5
End Sub
Private Sub Importer(LOSrc As ListObject, loDest As ListObject, nLigne As Long)
loDest.ListRows.Add.Range.Value = LOSrc.ListRows(nLigne).Range.Value
End Sub

2) Copie un tableau à la fin d'un autre

Sub CopierTableauAlaSuiteDunAutre()
Feuil2.ListObjects(1).DataBodyRange.Copy Feuil3.ListObjects(1).ListRows.Add.Range
End Sub

Nb: Faire les adaptations idoines au niveau des noms des feuilles.

 

[Lolote83]

Bonjour FLOW312020, STAPLE 1600,
Merci Staple 1600 pour ces quelques lignes qui vont bien me servir.
Deux questions cependant :

Question 1) Peut on à la place de l'index du tableau structuré y indiquer le nom en dur
Ton exemple : Importer Feuil2.ListObjects(1), Feuil3.ListObjects(1), 5
Avec le nom en dur : Importer "Tableau Données", "Tableau Archive"
Je sais que cela ne fonctionne pas en l'état, je cherche, mais je ne trouve pas
Ceci serait plus facile car j'ai dans un fichier au moins 15 tableaux structurés et je ne connais pas forcément les index de chaque tableau.
Cependant, ta solution est superbe.

Question 2) Dans le même esprit, peut on faire un couper-coller. Soit par ta méthode, soit l'autre.

Merci par avance.
Cordialement
@+ Lolote83

 

[chris]

Bonjour à tous

Le plus simple pour se référer à un tableau structuré c'est
Range("NonTableau").ListObject

Ainsi pas besoin de se référer à la feuille (les tableaux déménagent parfois et avec cette écriture on s'en fiche) ni à un index ou autre

 

[Lolote83]

Bonjour Chris.
Yes, merci beaucoup.
J'y étais presque, il me manquait que le .listObjet après mon range.
Par contre, une idée pour le couper-coller.
@+ Lolote83

 

[chris]

RE

Il y a 2 demandes sur ce fil ?

A priori en mode tableau je n'ai pas trouvé de déplacement possible, ni de paste special

2 propositions où le tableau Source est nommé Source3 et le tableau cible Cible3

La dernière ligne
Plage.Rows.Delete

peut être supprimée si c'est une copie

Les tableaux, Nlig et NbLig pouraient être passés en paramètres pour faire une sub générique

Pour ne copier que les valeurs

Sub DeplaceT1_to_T2()

'Déplacer n lignes en fin d'un autre tableau de même structure

    Dim Plage As Range, NLig As Long, NbLig As Long, Y As Long, X As Integer, WS As Worksheet

    Application.ScreenUpdating = False
    NLig = 5  'Ligne Excel de la 1ère ligne à déplacer
    NbLig = 3 'Nombre de lignes à déplacer

    With Range("Source3").ListObject
        Set Plage = .Range.Offset(.Range.Row + NLig - 2, 0).Resize(NbLig)
    End With

    With Range("Cible3").ListObject
        Y = .Range.Rows.Count + .Range.Row
        X = .Range.Columns.Count + .Range.Column - 1
        Set WS = .Parent 'si appel depuis autre feuille que celle du tableau cible
        WS.Range(WS.Cells(Y, .Range.Column), WS.Cells(Y + NbLig - 1, X)) = Plage.Value
    End With

    Plage.Rows.Delete

End Sub

Pour copier tout

Sub DeplaceT1_to_T2()

'Déplacer n lignes en fin d'un autre tableau de même structure

    Dim Plage As Range, NLig As Long, NbLig As Long, Y As Long, X As Integer, WS As Worksheet
    
    Application.ScreenUpdating = False
    NLig = 2  'Ligne Excel de la 1ère ligne à déplacer
    NbLig = 3 'Nombre de lignes à déplacer
    
    With Range("Source3").ListObject
        Set Plage = .Range.Offset(.Range.Row + NLig - 2, 0).Resize(NbLig)
    End With
    
    With Range("Cible3").ListObject
        Plage.Copy .ListRows.Add.Range
    End With
    
    Plage.Rows.Delete
End Sub

 

[Lolote83]

Re bonjour Chris,
Merci pour cette information.
Je connaissais effectivement la méthode du "Delete" mais je me demandais s'il n'y avait pas une autre méthode.
Merci pour ton implication. Je garde ton code précieusement
Cordialement
@+ Lolote83

 

[FLOW312020]

Bonjour à tous,

Je viens de me replonger dans le code aujourd'hui.
@Staple1600 Merci pour ta solution qui a fonctionné pour moi, c'est parfait!