1 seul message sur une boucle

Version imprimable

Bonjour à tous,

j'ai cette macro qui me permet de faire un filtre sur plusieurs onglets.

Je souhaite avoir un seul message si j'ai des données dans mon filtre. Mon code m'indique un message d'erreur pour chaque onglet alors que je n'en souhaite qu'un seul :
Code:

1 2 3 4 5 6 7 8 9 10 Sub Macro1() Dim feu As Long For feu = 4 To Sheets.Count Sheets(feu).Range("$A$6:$F$800").AutoFilter Field:=2, Criteria1:=RGB(248, 203, 173), Operator:=xlFilterCellColor MsgBox Range("A7:A30").SpecialCells(xlCellTypeVisible).Count Next feu End Sub
Merci par avance pour votre aide :)

Bonjour Caro, bonjour le forum,

Pas sûr d'avoir compris... Peut-être comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Macro1()
Dim feu As Long
Dim TEST As Boolean
For feu = 4 To Sheets.Count
    Sheets(feu).Range("$A$6:$F$800").AutoFilter Field:=2, Criteria1:=RGB(248, 203, 173), Operator:=xlFilterCellColor
    If TEST <> True Then
        TEST = True
        MsgBox Range("A7:A30").SpecialCells(xlCellTypeVisible).Count
    End If
Next feu
End Sub

30/01/2019, 15h06
Caro6

Oui ça marche par contre si je n'ai rien dans mon filtre ce qui peut arriver la macro bug sur ça :

Code:

MsgBox Range("A7:A30").SpecialCells(xlCellTypeVisible).Count
30/01/2019, 15h25
Caro6

Ta macro fonctionne si il y a une cellule sélectionnée présente dans le 1er onglet.

Mais si pas de cellule présente par le filtre dans l'onglet 1 mais une cellule présente par le filtre dans l'onglet 2 cela n'indique pas de message

Bonjour

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Macro1()
Dim Feu As Integer
Dim Msg As String
Dim N As Long
 
For Feu = 4 To Sheets.Count
    With Worksheets(Feu)
        .Range("$A$6:$F$800").AutoFilter Field:=2, Criteria1:=RGB(248, 203, 173), Operator:=xlFilterCellColor
        On Error Resume Next
        N = .Range("A7:A30").SpecialCells(xlCellTypeVisible).Count
        On Error GoTo 0
        Msg = Msg & vbNewLine & "Dans la feuille " & .Name & ", il y'a " & N & " lignes visibles."
        .Range("$A$6:$F$800").AutoFilter
    End With
Next Feu
MsgBox Msg
End Sub

30/01/2019, 16h46
Caro6

Yes Merci c'est TOP !

Une autre approche (parce que je n'aime pas les On Error) : :mrgreen:

Code:

1
2
3
4
5
6
7
8
9
Sub Macro1()
Dim feu As Long, Lig As Long
Lig=0
For feu = 4 To Sheets.Count
    Sheets(feu).Range("$A$6:$F$800").AutoFilter Field:=2, Criteria1:=RGB(248, 203, 173), Operator:=xlFilterCellColor
    Lig = Lig + Rows("6:30").SpecialCells(xlCellTypeVisible).Rows.Count - 1
Next feu
If Lig > 0 Then MsgBox Lig & " Ligne(s) touvée(s)" Else MsgBox "Tout est OK"
End Sub

31/01/2019, 10h29
Caro6

Bonjour Menhir ta macro marche très bien mais elle laisse les filtres actifs et je souhaite que les filtres disparaissent
31/01/2019, 10h58
Menhir

Il suffit de mettre un AutoFilter sans option en fin de macro.