Macro filtre bug car aucun critère

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion John38
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
J

John38

XLDnaute Nouveau
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.
 
Trier par date Trier par votes
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
 
Vote positif 0 Vote négatif
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
...
 
Vote positif 0 Vote négatif
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 !
 
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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...
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
250
MOLY_
M
M
  • Question Question
Autres Problème de sélection
Réponses
14
Affichages
247
fanch55
fanch55
arck
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
269
AtTheOne
AtTheOne
arck
  • Résolu(e)
XL 2019 Renvoyé à la ligne suivante si la ligne demandé n'est pas libre
Réponses
9
Affichages
144
Phil69970
Phil69970
N
  • Résolu(e)
Microsoft 365 Macro entre 2 classeurs
2
Réponses
19
Affichages
342
Nounours4173
N
eastwick
  • Résolu(e)
XL 2016 macro fichier fermé
Réponses
1
Affichages
96
eastwick
eastwick
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
547
ph.vanne
ph.vanne
H
  • Question Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
474
vgendron
vgendron
richardlion
  • Question Question
XL 2016 copier valeur actuel
2
Réponses
18
Affichages
315
sylvanu
sylvanu
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
M
  • Question Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
281
MICHIS
M
R
  • Question Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
TooFatBoy
C
  • Question Question
Microsoft 365 Enregistrer via VBA sans ouvrir fichier
Réponses
9
Affichages
359
cdric78
C
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
539
Phil69970
Phil69970
A
  • Résolu(e)
Microsoft 365 VBA filtre erreur si pas la condition
Réponses
3
Affichages
142
Ang3lina
A
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
881
Kevin38
K
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
450
micie1509
micie1509
L
  • Question Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
679
lolo_excelbeginner
L
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
1 K
MICHAEL
M
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
Retour