Macro filtre bug car aucun critère

John38 · 13 Juillet 2012

Bonjour,

Je suis novice en macro. Habituellement j'utilise que l'enregistreur de macro, mais là je ne peux résoudre mon problème sans le langage VBA. J'ai recherché quelques heures hier, mais sans succès.

Mon problème :
J'ai crée une macro qui filtre les données d'un tableau selon un critère d'équipement puis copie les pièces affectées sur cet équipement sur un autre tableau. Le problème est que ce mois si aucune pièces n'a été sortie sur un équipement. Quand je lance la macro, elle ne trouve pas le critère demandé (logiquement) et bug. J'aimerais rajouter une condition SI le critère n'est pas présent alors passer au deuxième critère. Je vous transmets ma ligne de code actuelle (les équipements sont 1, Video 1, 2 et 3).

Code:

Sub pieces_generales2()
'
' pieces_generales2 Macro
' Tri les pieces par equipement
'

'
    Sheets("Calculs").Select
    Range("A16:E16").Select
    Selection.AutoFilter
    Range("D16").Select
    ActiveSheet.Range("$A$16:$E$37").AutoFilter Field:=4, Criteria1:="1" _
        , Operator:=xlOr, Criteria2:="=Vidéo 1"
    Range("A17:E49").Select
    Selection.Copy
    Range("I4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("$A$16:$E$37").AutoFilter Field:=4, Criteria1:="2"
    Range("A17:E51").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("$A$16:$E$37").AutoFilter Field:=4, Criteria1:="3"
    Range("A17:E50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("U4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I4:M16").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A16:E16").Select
    Selection.AutoFilter
    Sheets("Calculs").Select
End Sub

Je ne peux pas vous transmettre le fichier pour des raisons de confidentialité. Je vous remercie par avance de votre aide.

youky(BJ) · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Bonjour john38,
Bienvenu au forum !
Voici une solution, tester le nombre de lignes restant après filtre.

if Application.SUBTOTAL(3,[A16:A65000])<1 Then exit sub

ceci fait que l'on quitte la macro si le nombre de ligne=0

Autre solution avec
On Error Resume next
'ligne ou l'erreur risque de se faire
if Err>0 then msgbox"Annulation":Exit sub

Bruno

John38 · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Par contre j'aimerais pas quitter la macro mais passer à l'étaper suivante. Exemple si pas d'équipement 1 passer à 2 et quitter macro. Est ce possible ?

Legolas · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Bonjour,

Oui c'est possible.

Code:

'Premier filtre
if Application.SUBTOTAL(3,[A16:A65000])<1 Then
    'ton code qui copie colle
end if

'Second filtre
if Application.SUBTOTAL(3,[A16:A65000])<1 Then
    'ton code qui copie colle
end if
...

John38 · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

J'ai une autre petite question, Il faut que je le colle au niveau de où ce code ? Je vous tiens au courant dans 1h du résultat je pars en réunion. Je vous remercie du temps que vous me consacrez.

Legolas · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Re,

Je pense que cela doit ressembler à ceci :

Code:

Sheets("Calculs").Select
Range("A16:E16").Select
Selection.AutoFilter
Range("D16").Select

'premier filtre
ActiveSheet.Range("$A$16:$E$37").AutoFilter Field:=4, Criteria1:="1" _
        , Operator:=xlOr, Criteria2:="=Vidéo 1"

'premier test
if Application.SUBTOTAL(3,[A16:A65000])<1 Then
   'si test ok, copie colle
   Range("A17:E49").Select
   Selection.Copy
   Range("I4").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
end if

'second filtre
ActiveSheet.Range("$A$16:$E$37").AutoFilter Field:=4, Criteria1:="2"

'second test
if Application.SUBTOTAL(3,[A16:A65000])<1 Then
   'si test ok, copie colle
   Range("A17:E51").Select
   Application.CutCopyMode = False
   Selection.Copy
   Range("O4").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
end if

'troisième filtre
ActiveSheet.Range("$A$16:$E$37").AutoFilter Field:=4, Criteria1:="3"

'troisième test
if Application.SUBTOTAL(3,[A16:A65000])<1 Then
   'si test ok, copie colle
   Range("A17:E50").Select
   Application.CutCopyMode = False
   Selection.Copy
   Range("U4").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Faire la mise en forme
    Range("I4:M16").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A16:E16").Select
    Selection.AutoFilter
    Sheets("Calculs").Select

A plus !

John38 · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Je suis désolé de vous déranger encore. Mais j'ai lancé la macro et il me dit Bloc IF sans IF

John38 · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

J'ai trouvé il manquait un End If en revanche la macro ne marche pas. Elle s'execute sans erreur, mais les 2 tableaux qui devraient être remplis car il y a des pièces sorties sur ces équipements ne le sont pas. Je pense que la macro voit qu'il n'y a pas de données pour le première équipement elle s'arrête au lieu d'aller chercher les autres critères.

Legolas · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Re,

Désolé pour l'oubli du End If
Par contre la macro ne s'arrete pas : il n'y a pas d' "Exit Sub" dans le code.
Quoi qu'il arrive les 3 filtres sont testés.

Sans fichier, c'est dur de se faire une idée de ce qu'il se passe.
Ne pouvez vous pas modifier les données pour qu'il ne soit plus confidentiel et nous faire parvenir une pièce jointe ?

A plus

John38 · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

J'ai trouvé l'erreur à un moment de la macro tu as mis if Application.SUBTOTAL(3,[A16:A65000])<1 Then
Il fallait mettre >1 et la sa marche

Legolas · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

Complètement...
J'ai été un peu rapide dans le copier coller des codes.

Il faut mettre >0 sur tous les tests !

Le test sert à savoir s'il y a des données (ou non) :
- la première proposition de youky était : si pas de données sortir de la macro (donc test <1)
- ce que j'ai voulu faire : s'il y a des données, exécuter le copier coller (donc >0)

Désolé pour cette erreur de ma part.

A plus

PS : Et comme quoi, il vaut mieux marcher...

John38 · 13 Juillet 2012

Re : Macro filtre bug car aucun critère

>0 sa ne marche pas il y a que >1 qui marche

Macro filtre bug car aucun critère

John38

XLDnaute Nouveau

youky(BJ)

XLDnaute Barbatruc

John38

XLDnaute Nouveau

Legolas

XLDnaute Occasionnel

John38

XLDnaute Nouveau

Legolas

XLDnaute Occasionnel

John38

XLDnaute Nouveau

John38

XLDnaute Nouveau

Legolas

XLDnaute Occasionnel

John38

XLDnaute Nouveau

Legolas

XLDnaute Occasionnel

John38

XLDnaute Nouveau

Discussions similaires