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

XL 2013 Couper-coller ligne sans formulaire entre 2 tableaux structurés

A

Ananas94

XLDnaute Junior
Bonjour,

Après maintes recherches sur les forums, je ne trouve toujours pas de solution à mon problème qui est pourtant à mon avis assez simple ....
J'ai 2 tableaux : un avec des données de l'année courante et un autre avec des données de l'année dernière, qui est une archive. Je souhaite, lors d'un changement d'année, enlever les données de l'année passée qui sont dans le tableau de départ et les placer dans le tableau d'archive (tableau d'arrivée).
J'ai fait une macro (cf fichier joint), mais le résultat n'est pas du tout celui attendu et je ne comprends pas pourquoi !!

Quelqu'un pourrait m'aider s'il vous plaît ?
Merci
 

Pièces jointes

  • Couper_lig_essai.xlsm
    21.6 KB · Affichages: 10
Solution
Si l'on veut supprimer les lignes copiées du tableau Depart on utilisera ce fichier (2) et la macro :
VB: 
Sub Archive_donnees()
Dim dest As Range
With [Arrivee].ListObject.Range.Columns(1)
    Set dest = .EntireColumn.Find("", .Cells(1), xlValues) '1ère cellule vide de destination
End With
Application.ScreenUpdating = False
With [Depart].ListObject.Range
    .Columns(2).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(2) = "=1/(YEAR(RC[-1])=YEAR(TODAY()))"
    .Columns(2) = .Columns(2).Value 'supprime les formules
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    With Intersect(.Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells)...
Trier par date Trier par votes

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Ananas, bonjour le forum,

Peut-être comme ça :
VB: 
Sub Archive_donnees()
Dim LO1 As ListObject, LO2 As ListObject
Dim PL1 As Range, PL2 As Range
Dim I As Integer

Set LO1 = Sheets("Depart").ListObjects("Depart")
Set PL1 = LO1.DataBodyRange
Set LO2 = Sheets("Arrivee").ListObjects("Arrivee")
Application.ScreenUpdating = False
For I = PL1.Rows.Count To 1 Step -1
    If Year(PL1.Item(I, 1)) <> Year(Date) Then
        LO2.ListRows.Add
        Set PL2 = LO2.DataBodyRange
        PL1.Rows(I).Copy PL2.Item(PL2.Rows.Count, 1)
        LO1.ListRows(I).Delete
    End If
Next I
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
Bonjour.
Votre LO1.Range(i, 1).Rows.Delete ne va pas du tout :
Les lignes d'une seule cellule ça reste une seule cellule, et en l'absence de spécification de xlShift il risque de déplacer vers la gauche celles à sa droite. Sans compter que s'il fonctionnait ça ferait remonter le reste des lignes et que vous en louperiez une au passage suivant dans la boucle.
À votre place j'utiliserais deux tableaux dynamiques.
 
Dernière édition:
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
Bonjour @Robert
Ma version avec les tableaux :
VB: 
Option Explicit
Sub Archive_donnees()
   Dim LOtDon As ListObject, LOtArc As ListObject, TDonn(), LDIni As Long, LDRes As Long, TArch(), LArch As Long, C As Long
   Set LOtDon = Sheets("Depart").ListObjects("Depart")
   Set LOtArc = Sheets("Arrivee").ListObjects("Arrivee")
   TDonn = LOtDon.DataBodyRange.Value
   ReDim TArch(1 To UBound(TDonn), 1 To UBound(TDonn, 2))
   For LDIni = 1 To UBound(TDonn, 1)
      If Year(TDonn(LDIni, 1)) <> Year(Date) Then
         LArch = LArch + 1
         For C = 1 To UBound(TDonn, 2): TArch(LArch, C) = TDonn(LDIni, C): Next C
      Else
         LDRes = LDRes + 1
         For C = 1 To UBound(TDonn, 2): TDonn(LDRes, C) = TDonn(LDIni, C): Next C
         End If
      Next LDIni
   If LDRes < LOtDon.ListRows.Count Then
      LOtDon.ListRows(LDRes + 1).Range.Resize(LOtDon.ListRows.Count - LDRes).Delete xlShiftUp
      If LDRes > 0 Then LOtDon.DataBodyRange.Value = TDonn
      End If
   If LArch > 0 Then
      LOtArc.ListRows.Add.Range.Resize(LArch).Value = TArch
      End If
   End Sub
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bonjour Ananas94, Robert, Bernard,

Avec le filtre avancé c'est assez simple :
VB: 
Sub Archive_donnees()
Dim F As Worksheet, dest As Range, critere As Range
With [Arrivee].ListObject.Range.Columns(1)
    Set F = .Parent
    Set dest = .EntireColumn.Find("", .Cells(1), xlValues) '1ère cellule vide de destination
End With
With [Depart].ListObject.Range
    Set critere = .Cells(2, .Columns.Count + 2)
    critere = "=YEAR(" & .Cells(2, 1).Address(0) & ")<>YEAR(TODAY())"
    .AdvancedFilter xlFilterCopy, critere(0).Resize(2), dest 'filtre avancé
End With
dest.ListObject.Resize dest.CurrentRegion 'redimensionne le tableau
dest.EntireRow.Delete 'supprime la ligne d'en-têtes copiée
critere = ""
F.Activate 'facultatif
End Sub
PS1: c'est un copier-coller, pas un couper-coller.

PS2 : j'ai mis le style de référence A1 au lieu de L1C1...

A+
 

Pièces jointes

  • Couper_lig_essai(1).xlsm
    22.1 KB · Affichages: 1
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Si l'on veut supprimer les lignes copiées du tableau Depart on utilisera ce fichier (2) et la macro :
VB: 
Sub Archive_donnees()
Dim dest As Range
With [Arrivee].ListObject.Range.Columns(1)
    Set dest = .EntireColumn.Find("", .Cells(1), xlValues) '1ère cellule vide de destination
End With
Application.ScreenUpdating = False
With [Depart].ListObject.Range
    .Columns(2).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(2) = "=1/(YEAR(RC[-1])=YEAR(TODAY()))"
    .Columns(2) = .Columns(2).Value 'supprime les formules
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    With Intersect(.Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Cells) 'constantes #DIV/0!
        .Columns(2).EntireColumn.Delete 'supprime la colonne auxiliaire
        .Copy dest 'copier-coller
        .EntireRow.Delete 'supprime les lignes
    End With
End With
dest.Parent.Activate 'facultatif
End Sub
Cette méthode est classique et très rapide grâce au tri de regroupement.
 

Pièces jointes

  • Couper_lig_essai(2).xlsm
    23 KB · Affichages: 3
Vote positif 0 Vote négatif
Solution

job75

XLDnaute Barbatruc
Il est intéressant de comparer les durées d'exécution après recopie du tableau Depart sur 99 000 lignes.

Chez moi sur Win 10 Excel 2019 :

- macro du post #2 => 13 minutes

- macro du post #4 => 0,75 seconde

- macro du post #5 => 56 secondes (filtre avancé)

- macro du post #6 => 0,64 seconde.
 
Vote positif 0 Vote négatif
A

Ananas94

XLDnaute Junior
Bonjour Dranreb,
Merci pour votre remarque, je ne savais pas en effet, et je ne comprenais pas pourquoi la première colonne était supprimée. Il n'est vraiment pas évident (et je pense que je n'ai toujours pas compris d'ailleurs) de manipuler une LIGNE d'un tableau structuré en VBA.
Merci en tout cas
 
Vote positif 0 Vote négatif
A

Ananas94

XLDnaute Junior
Bonjour Robert,
Merci beaucoup pour votre réponse. Je viens de tester votre code et il fonctionne, mille mercis !
Donc si j'ai bien compris (je ne suis pas une pro du VBA..), pour désigner une ligne d'un tableau structuré (j'ai toujours du mal), on écrit : LO1.DataBodyRange.Rows(i) (en le déclarant comme une variable de type range, et i le numéro de la ligne dans le tableau).
Merci à vous
 
Vote positif 0 Vote négatif
A

Ananas94

XLDnaute Junior
Bonjour Dranreb,

Merci beaucoup pour votre code, il fonctionne aussi super bien ; vous êtes tous trop forts décidément
Donc ici, si j'ai bien compris, vous créez "par-dessus" le tableau structuré un tableau dynamique (avec Ubound). Si j'ai bien compris, vous prenez en compte la possibilité que le tableau soit vide (et donc l'ajout d'une ligne).
Merci beaucoup,
Excellente journée

NB : Je ne parviens pas à désigner également votre post comme solution, j'ai l'impression qu'il ne peut y en avoir qu'une (ce qui n'est pas spécialement vrai ...)
 
Vote positif 0 Vote négatif
A

Ananas94

XLDnaute Junior
Bonjour Job75,
Merci beaucoup pour votre aide, je ne connaissais pas cette possibilité pour les filtres avancés, mais c'est drôlement ingénieux, bravo. Merci, ça m'apprends pleins de trucs. Je ne parviens pas à faire fonctionner ovter code sur ma feuille, mais je ne dois pas sûrment pas tout saisir, je vais creuser. Je suis convaincue qu'il est bien ficelé.
Excellente journée

NB: Comme Dranreb, je n'arrive pas à désigner votre post comme solution au problème...
 
Vote positif 0 Vote négatif
A

Ananas94

XLDnaute Junior
En effet, la dernière est très efficace. Enfin en tout cas, toutes fonctionnent, bravo et merci à tous. Vous êtes des génies !
 
Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc
Ananas94 à dit:
Il n'est vraiment pas évident (et je pense que je n'ai toujours pas compris d'ailleurs) de manipuler une LIGNE d'un tableau structuré en VBA.
Cliquez pour agrandir...
Je trouve que si car elle correspond à un objet ListRow contenu dans une collection ListRows
Cet objet ListRow porte une propriété Range couvrant les cellules de la ligne représentée.
Ananas94 à dit:
Donc ici, si j'ai bien compris, vous créez "par-dessus" le tableau structuré un tableau dynamique (avec Ubound).
Cliquez pour agrandir...
Un tableau dynamique est créé en mémoire seulement. Mais il peut ensuite être affecté à la propriété Value d'un Range représentant plusieurs cellules. UBound permet juste de connaitre les dimensions maxi d'un tableau dynamique.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

B
  • Question
XL 2016 Fusionner 2 tableaux sans connaître le nombre de ligne des 2 tableaux
Réponses
12
Affichages
1 K
mapomme
V
  • Question
Microsoft 365 ajout ligne entre 2 lignes, et déplace données partielle sur nouvelle ligne
Réponses
3
Affichages
550
vgendron
S
  • Question
XL 2019 Déplacer ligne d'un tableau avec formule INDIRECT dans un autre tableau
Réponses
2
Affichages
602
Smookie
S
L
  • Résolu(e)
XL 2013 Garder espace de 1 ou 2 ligne(s) entre tableaux structurés sur une même feuille
Réponses
13
Affichages
2 K
Leguyl
L
D
  • Résolu(e)
XL 2016 Fusionner 2 tableaux en 1 ou copier coller une ligne sur 2
Réponses
14
Affichages
2 K
chris
A
  • Résolu(e)
XL 2013 Recherche de la lettre de la colonne d'une cellule
Réponses
2
Affichages
698
Ananas94
A
M
  • Question
XL 2013 VBA : Remplir un tableau nommé et insérer lignes via formulaire
Réponses
1
Affichages
2 K
fanfan38
T
  • Résolu(e)
XL 2013 Couper-coller ligne d'un tableau structuré dans un autre tableau
2
Réponses
24
Affichages
4 K
themyse1
T
A
  • Résolu(e)
XL 2013 Ajouter des formules dans un tableau de dimensions variables
2 3 4
Réponses
48
Affichages
5 K
Ananas94
A
E
  • Question
Macro VBA Excel - copier coller données sans ouvrir les fichiers
Réponses
4
Affichages
7 K
excel girl
E
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…