Discussion :

[magicsismic]

Je ne comprends pas non plus l'utilité d'un UserForm !

S'il est question d'archiver / supprimer des lignes avec une codification "obsolète",
via un filtre ou un filtre avancé c'est instantané en à peine dix lignes de code …

Là c'est limite une usine à gaz !

En fait comme il s'agit d'un fichier partagé je veux seulement copier les lignes contenant obsolète dans l'onglet archives sans supprimer aucune ligne de l'onglet "Cvtheque"
Pour ce qui est du recours à un Userform. Je souhaite que les lignes à archiver puissent apparaître dans une listbox avant l'archivage dans un soucis de contrôle des informations.
le code de Thautheme est très rapide mais ne permet pas de récupérer des lignes entières. J'ai regardé du côté de la propriété application.index mais çà n'a pas l'air de fonctionner...
Marc-L si tu as une idée pour utiliser un autofilter avec un fichier partagé je suis preneur

[Marc-L]

Dès qu'il est question de partage, oublier Excel et envisager Access !
Surtout dans un contexte professionnel notamment en RH …

Sinon dictionnaire superflu, utiliser une variable tableau pour les numéros de lignes à traiter.
Il serait aussi judicieux de n'afficher que les informations pertinentes au lieu des lignes entières …

[gnain]

Bonjour,
J'ai fait le test tel que promis,

J'ai créer 2 nouveaux boutons un qui s'appelle Lister, et l'autre Archivé.
J'ai mis environ 20000 lignes qui contient Obselète environ 3600 fois.

Je n'ai pas touché à votre code

J'ai effacer toute les lignes pour pouvoir le mettre en pièces jointe.

Temps pour Lister: 2 secondes
Temps pour Archivé: 3 Secondes

Il ne reste plus qu'à l'intégré à ton projet.

[Thautheme]

Bonsoir le fil, bonsoir le forum,

le code de Thautheme est très rapide mais ne permet pas de récupérer des lignes entières.

Tu avais raison pour les lignes il fallait Ubound(TC, 1) au lieu de Ubound(TC, 2).
Le code copie bien la ligne entière mais il faut ajuster le nombre de colonnes de la ListBox3 pour qu'elle puisse l'afficher avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

UserForm2.ListBox3.ColumnCount = UBound(TC, 2)

Le code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Public Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément de ligne)
Dim J As Integer 'déclare la variable J (incrément de colonne)
Dim K As Integer 'déclare la variable K (incrément de colonne)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
 
Set O = Sheets("Cvtheque") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellule TC
J = 1 'initialise la variable J
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
    If UCase(TC(I, 29)) Like "OBSOL*" = True Then 'condition si la valeur en ligne I colonne 29 (=> colonne AC) de TC contient "Obsolète"
        'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonnes, J colonnes)
        ReDim Preserve TL(1 To UBound(TC, 2), 1 To J)
        For K = 1 To UBound(TC, 2) 'boucles 2 : sur toutes les colonnes K de TC
            TL(K, J) = TC(I, K) 'renvoie dans la ligne K de TL la valeur de la colonne K de TC (transposition)
        Next K 'prochaine colonne de la boucle 2
        J = J + 1 'incrémente J (ajoute une colonne au tableau TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If J = 1 Then Exit Sub 'si J=1 (=> aucune occurrence "Obsolète" trouvée), sort de la procédure
If J = 2 Then 'consition : si J=2 (=> une seule occurrence trouvée)
    ReDim Preserve TL(UBound(TL, 1), 2) 'redimensionne TL pour pouvoir transposer
Else 'sinon
    UserForm2.ListBox3.ColumnCount = UBound(TC, 2) 'définit le nombre de colonnes de la ListBox3
    UserForm2.ListBox3.List = Application.Transpose(TL) 'alimente la ListBox3 de l'UserForm2 du tableau TL transposé
End If 'fin de la condition
End Sub

[magicsismic]

Gnain et Thauthème vos deux solutions sont aussi rapide l'une que l'autre, merci à vous deux. C'est exactement ce qu'il me fallait.
Merci aussi à Marc-L pour tes conseils et ton aide
Je mets la discussion en résolu

[Thautheme]

Bonjour le fil, bonjour le forum,

Après test, j'ai légèrement modifié le code pour supprimer une erreur (cas d'une seule occurrence d'Obsolète trouvée) et afficher la label ALarchive si aucun Obsolète n'est trouvé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub CommandButton12_Click()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément de ligne)
Dim J As Integer 'déclare la variable J (incrément de colonne)
Dim K As Integer 'déclare la variable K (incrément de colonne)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
 
Set O = Sheets("Cvtheque") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellule TC
J = 1 'initialise la variable J
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
    If UCase(TC(I, 29)) Like "OBSOL*" = True Then 'condition si la valeur en ligne I colonne 29 (=> colonne AC) de TC contient "Obsolète"
        'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonnes, J colonnes)
        ReDim Preserve TL(1 To UBound(TC, 2), 1 To J)
        For K = 1 To UBound(TC, 2) 'boucles 2 : sur toutes les colonnes K de TC
            TL(K, J) = TC(I, K) 'renvoie dans la ligne K de TL la valeur de la colonne K de TC (transposition)
        Next K 'prochaine colonne de la boucle 2
        J = J + 1 'incrémente J (ajoute une colonne au tableau TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
If J = 1 Then 'si J=1 (=> aucune occurrence "Obsolète" trouvée)
    Me.ALarchive.Visible = True 'affiche la label ALarchive
    Exit Sub 'sort de la procédure
End If 'fin de la condition
If J = 2 Then 'consition : si J=2 (=> une seule occurrence trouvée)
    ReDim Preserve TL(1 To UBound(TL, 1), 1 To 2) 'redimensionne TL pour pouvoir transposer
End If 'fin de la condition
UserForm3.ListBox3.ColumnCount = UBound(TC, 2) 'définit le nombre de colonnes de la ListBox3
UserForm3.ListBox3.List = Application.Transpose(TL) 'alimente la ListBox3 de l'UserForm2 du tableau TL transposé
End Sub