Copie lignes sous conditions dans autre Worksheet

Bonjour à tous,

J'ai un fichier Excel composé de 2 Worksheets :

- une base de données où sont recensées toutes les étiquettes potentiellement imprimables (différentes d'un projet à un autre).

- une worksheet vide dans laquelle j'aimerais indiquer toutes les étiquettes à imprimer.

Pour ce faire, j'utilise en Colonne A de la base de données des conditions qui permettent de retourner "1" quand l'étiquette est à imprimer.

J'ai réussi à créer une macro qui parcourt toutes les lignes de la feuille "base de données"et qui copie la ligne dans la feuille à imprimer quand il y a un "1" en colonne A.

J'utilise une boucle for mais ma macro est longue en traitement (quelques minutes car beaucoup de lignes).

Auriez vous des solutions pour la rendre plus rapide ? (stocker dans un tableau "virtuel" les lignes à copier et faire qu'une opération à la fin ?). Mon niveau VBA est trop limité même si je me réjouis d'avoir trouvé une solution seul de mon côté.

Merci d'avance pour vos retours et bonne journée,

Mav'

Bonjour MAVERICK39,

Voici une première proposition.

Bonjour

Auriez vous des solutions pour la rendre plus rapide ?

Dans votre fichier, si vous faites appel à VBA il faut enlever vos cellules fusionnées (comme dit souvent VBA aime pas et sans VBA aussi d'ailleurs). Les fusions c'est toujours "chercher" un problème. Donc là mettez l'info à chaque cellule de la colonne B.
Mettez aussi un titre dans vos colonnes.

Ensuite le code ci-dessous à mettre dans un module et à associer à votre bouton.

Sub test()
Dim c As Range
Dim dlg As Integer

Application.ScreenUpdating = False
With Sheets("base de données_étiquettes")
    Set c = .Range("A:A").Find(1, LookIn:=xlValues)
    If Not c Is Nothing Then
        prem = c.Address
        Do
            dlg = Sheets("étiquettes à imprimer").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("étiquettes à imprimer").Range("A" & dlg).Resize(, 4) = .Range("A" & c.Row & ":D" & c.Row).Value
            Set c = .Range("A:A").FindNext(c)
        Loop While Not c Is Nothing And c.Address <> prem
    End If
End With
End Sub

Crdlt

Edit : ma solution différente de Valky, qui utilise le filtre puis copie la plage complète.
Mais on peut supprimer les Select (cela ralentit toujours VBA), la ligne activesheet.paste et les 2 applications calculation (intérêt si calcul dans votre feuille) et events.
A la place des select, une seule ligne suffit --> Range("I1").CurrentRegion.Cut Feuil2.Range("A1")

Bonjour à tous les deux et merci pour vos retours.

Vos deux solutions fonctionnent à merveille, merci infiniment !

La macro met 10 fois moins de temps à fonctionner.