XL 2013 Copier / coller / supprimer dans un tableau vers un autre selon une condition

Dae_mon

XLDnaute Nouveau
Bonjour à toutes et tous,

Pour le boulot, je souhaite pouvoir, d'un tableau où sont renseignés des tâches à faire et fait, "archiver" ces dernières dans un deuxième tableau (Condition => Fait)

J'ai trouvé sur le net une fonction permettant de le faire.

Je souhaite l'adapter à des tableaux nommés (Cf. fichier joint). Au final, ces tableaux seront sur deux feuilles différentes mais comme c'est des tableaux nommés, je pense que cela n'a pas d'importance pour l'instant de l'emplacement.

Dans le fichier j'ai gardé en commentaire le code de base.

Merci pour votre aide.

Dae_mon
 

Pièces jointes

  • testpreventif.xlsm
    24.4 KB · Affichages: 7
Solution
Bonsoir Dae_mon,
Un essai en PJ avec :
VB:
Sub transfert()
    Dim Lbase%, L%, C%
    Application.ScreenUpdating = False
    Lbase = [Archivage].Rows.Count                              ' Nombre de lignes de Archivage
    For L = 1 To [Base].Rows.Count                              ' Pour toutes les lignes de Base
        If LCase([Base[Colonne 3]].Item(L)) = "fait" Then       ' Si "Fait" en colonne 3 ( casse ignorée )
            If [Archivage].Item(Lbase, 1) <> "" Then
                [Archivage].ListObject.ListRows.Add             ' Add row si première ligne
                Lbase = Lbase + 1                               ' Ajuste nb lignes
            End If
            [Archivage].Rows(Lbase).Value = [Base].Rows(L).Value ' ' Transfert de Base vers Archivage...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Dae_mon,
Un essai en PJ avec :
VB:
Sub transfert()
    Dim Lbase%, L%, C%
    Application.ScreenUpdating = False
    Lbase = [Archivage].Rows.Count                              ' Nombre de lignes de Archivage
    For L = 1 To [Base].Rows.Count                              ' Pour toutes les lignes de Base
        If LCase([Base[Colonne 3]].Item(L)) = "fait" Then       ' Si "Fait" en colonne 3 ( casse ignorée )
            If [Archivage].Item(Lbase, 1) <> "" Then
                [Archivage].ListObject.ListRows.Add             ' Add row si première ligne
                Lbase = Lbase + 1                               ' Ajuste nb lignes
            End If
            [Archivage].Rows(Lbase).Value = [Base].Rows(L).Value ' ' Transfert de Base vers Archivage
            '[Archivage].Item(Lbase, 3) = Date                   ' Isertion date ds Archivage ( non activée )
            Lbase = Lbase + 1                                   ' Prochaine ligne d'écriture dans Archivage
            [Base].ListObject.ListRows(L).Delete                ' Suppression de la ligne dans Base
            L = L - 1                                           ' Réindexation de la prochaine ligne à traiter
        End If
    Next L
End Sub
Comme dans Archivage la 3eme colonne vaudra toujours "Fait" elle semble inutile. On peut la remplacer par la date d'archivage. Dans ce cas validez la ligne: [Archivage].Item(Lbase, 3) = Date
 

Pièces jointes

  • testpreventif (1).xlsm
    25.7 KB · Affichages: 7
Dernière édition:

Dae_mon

XLDnaute Nouveau
Bonsoir Dae_mon,
Un essai en PJ avec :
VB:
Sub transfert()
    Dim Lbase%, L%, C%
    Application.ScreenUpdating = False
    Lbase = [Archivage].Rows.Count                              ' Nombre de lignes de Archivage
    For L = 1 To [Base].Rows.Count                              ' Pour toutes les lignes de Base
        If LCase([Base[Colonne 3]].Item(L)) = "fait" Then       ' Si "Fait" en colonne 3 ( casse ignorée )
            If [Archivage].Item(Lbase, 1) <> "" Then
                [Archivage].ListObject.ListRows.Add             ' Add row si première ligne
                Lbase = Lbase + 1                               ' Ajuste nb lignes
            End If
            [Archivage].Rows(Lbase).Value = [Base].Rows(L).Value ' ' Transfert de Base vers Archivage
            '[Archivage].Item(Lbase, 3) = Date                   ' Isertion date ds Archivage ( non activée )
            Lbase = Lbase + 1                                   ' Prochaine ligne d'écriture dans Archivage
            [Base].ListObject.ListRows(L).Delete                ' Suppression de la ligne dans Base
            L = L - 1                                           ' Réindexation de la prochaine ligne à traiter
        End If
    Next L
End Sub
Comme dans Archivage la 3eme colonne vaudra toujours "Fait" elle semble inutile. On peut la remplacer par la date d'archivage. Dans ce cas validez la ligne: [Archivage].Item(Lbase, 3) = Date
Merci pour la réponse rapide.

Je regarde à cela cette après-midi.

Bon weekend.
 

Discussions similaires

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA