Discussion :

[Platon d'athene]

bonjour tout le monde
je suis entrain de developper un script VBA qui fait les operations suivantes:

- filtrer les elements d'une feuille selon des critères bien précis.
- selectionner les lignes qui viendront après le filtrage , les copier et les coller dans une autre feuille.
- enfin retour à la première feuille et suppression de ces lignes filtrés.

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
Sheets("feuille1").Select
    Range("A1").Select
 
 
  Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$3000").AutoFilter Field:=4, Criteria1:="critère1"         
     ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Select
        Selection.Copy
 
   Sheets("feuille2").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("other").Select
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete

le problème ici, c'est que lorsqu'on a pas des lignes aui apparaissent lors du filtrage, toutes les lignes de la feuille1 seront selectionnées , collées dans la feuille2, et enfin supprimées de la feuille1

any suggestions please ?

[Supermichou]

Bonjour,

essaye re rajouter ceci

Code :

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

if selection.rows.count = 3000 then exit sub

Michel

[Platon d'athene]

merci pour la reponse,
mais le probleme c'est que je ne veux pas sortir du macro , il y a un autre traitement a faire , ce n'est qu'une portion du code, et le deuxieme c'est que le nombre des lignes selectionnées ne depend pas du "3000" ça peut être un nombre inferieure,
ce que j'ai besoin ici , c'est faire une condition qui tiendra en compte les cas ou le filtrage ne fait sortir aucun resultat,,

[Supermichou]

alors tu fais

Code :

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

if selection.rows.count = 3000 then goto 1

et tu mets la balise 1 dans la marge, un simple petit 1 à gauche du texte, jute après la zone de code à passer.

[Platon d'athene]

michel , je l'ai essayé mais ça n'a pas marché, en fait , une solution plus générique pouura être plus fiable, j'ai vu dans d'autres forum l'utilisation de "Selection.SpecialCells(xlCellTypeVisible)" ,,, mais en vain

[gFZT82]

Bonjour,

Tu peux essayer comme cela

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
Sub Test()
Dim WsCible As Worksheet
Dim Plage As Range, PlageFiltree As Range
    Application.ScreenUpdating = False
    Set WsCible = Worksheets("feuille2")
    NextRow = WsCible.Cells(WsCible.Rows.Count, 1).End(xlUp).Row + 1
    With Worksheets("feuille1")
        Set Plage = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row)
        .Range("A1").AutoFilter
        .Range("$A$1:$D$3000").AutoFilter Field:=4, Criteria1:="critère1"
        On Error GoTo Gestion_erreur
        'Copier/Coller de la plage filtrée dans "feuille2"
        Plage.SpecialCells(xlCellTypeVisible).Copy WsCible.Cells(NextRow, 1)
    End With
    'Suppression de la plage filtrée dans "feuille1"
    Plage.EntireRow.Delete
    Worksheets("feuille1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
    Exit Sub
Gestion_erreur:
    Worksheets("feuille1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Cordialement.

[Philippe Tulliez]

Bonjour,
Dans les exemples ci-dessous, db représente un objet range délimitant la base de données.
Si tu souhaites vérifier que la base de données filtrées ne contient aucune données

Code :

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

db.SpecialCells(xlCellTypeVisible).Count = db.Columns.Count

Si tu veux savoir si le nombre de lignes de la base filtrée est différent de la base d'origine

Code :

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

(db.SpecialCells(xlCellTypeVisible).Count / db.Columns.Count) <> db.Rows.Count

Exemple
Ce code ne copie la base filtrée que si elle contient des données

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TestFiltre()
 Dim db As Range, toRng As Range
 With ThisWorkbook
  Set db = .Worksheets("db").Range("A1").CurrentRegion
  Set toRng = .Worksheets("Feuil1").Range("A1")
 End With
 ' Filtre + Copie
 db.AutoFilter Field:=6, Criteria1:="M"
 Select Case True
  Case db.SpecialCells(xlCellTypeVisible).Count <> db.Columns.Count
    db.SpecialCells(xlCellTypeVisible).Copy toRng
 End Select
End Sub

[Platon d'athene]

merci les gars c'est résolu