XL 2019 Problème copier/coller tableau structuré

FLOW312020

XLDnaute Nouveau
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.

VB:
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
 
Solution
Bonjour le fil

Avec et selon ce que j'ai compris
1) copie une ligne d'une tableau à la la fin d'un autre
VB:
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
VB:
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.

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Avec et selon ce que j'ai compris
1) copie une ligne d'une tableau à la la fin d'un autre
VB:
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
VB:
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

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

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

chris

XLDnaute Barbatruc
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
VB:
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

VB:
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
 
Dernière édition:

Lolote83

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

Discussions similaires

Réponses
5
Affichages
124