VBA excel problème de copier/coller filtre [Résolu/Fermé]

Signaler
Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008
-
Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008
-
Bonjour,

J'ai créer une macro pour sélectionner, copier et coller des données d'une feuille active suivant certains critères
Mais quand le filtre ne trouve pas de données qui correspond à mon critère il me copie/colle les données de la feuille 1 initiale !
Voici ma macro

Sub Macro1()

z = 3
While z < 13
Sheets(z).Select 'Selection feuille active
Selection.AutoFilter Field:=2, Criteria1:="Contrôle Mécanique" 'filtre contrôle mécanique seulement
Selection.AutoFilter Field:=4, Criteria1:="1" ' critère de filtre =1
Range("N23:N1000").Select 'Selection des cellules à copier
Selection.Copy
Range("A9").Select 'Colonne et ligne ou doit etre collé les données
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False
Range("A9:A200").Select
Selection.Sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'range en ordre croissant
Range("A9").Select
Rows("1:500").EntireRow.AutoFit 'mise en forme automatique
z = z + 1
Sheets("1").Select
Range("A1").Select
Wend
End Sub

Est ce que je dois mettre une condition sur l'autofiltre pour qu'il ne copie/colle aucune données?
Si le filtre n'a pas de données "contrôle mécanique" il ne doit rien me copier/coller sur mon tableau.
Comment dois je procéder?
Merci d'avance
Bonne journée

2 réponses

Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 111
une solution...
Dim CelR   As Range
Sheets(z).Select
Set CelR = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)
CelR.Select
a = CelR.Address
if len(a)>11 then 'Il y a une ou plusieurs lignes à copier.
    celR.copy Range("A9")


end if

A+
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 60511 internautes nous ont dit merci ce mois-ci

Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008

Bonjour,

Sa marche nickel merci beaucoup!!!
Voici le code au complet

Dim CelR As Range

z = 3
Sheets("1").Select
While z < 15
Sheets(z).Select
Set CelR = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)
CelR.Select
a = CelR.Address
If Len(a) > 11 Then 'Il y a une ou plusieurs lignes à copier.
Selection.AutoFilter Field:=2, Criteria1:="Contrôle Mécanique" 'filtre contrôle mécanique seulement
Selection.AutoFilter Field:=4, Criteria1:="1" ' critère de filtre =1
Range("N23:N1000").Select 'Selection des cellules à copier
Selection.Copy
Range("A9").Select 'Colonne et ligne ou doit etre collé les données
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False
Range("A9:A200").Select
Selection.Sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'range en ordre croissant
Range("A8").Select
Rows("1:500").EntireRow.AutoFit 'mise en forme automatique
z = z + 1
End If
Wend
Sheets("1").Select
Range("A1").Select
End Sub

Cordialement,

Roberto93
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 111
bonjour,
1ère chose que je comprend pas...tu met,
z = z + 1 
Sheets("1").Select 
Range("A1").Select 
Wend 

donc revient au dessus et là tu met...


While z < 13 
Sheets(z).Select 'Selection feuille active 


?
A+
Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008

J'ai mal placé les codes, il ne devait pas être dans la boucle while j'ai modifié

z = z + 1
Wend
Sheets("1").Select
Range("A1").Select

Est ce que vous pouvez m'aider à résoudre mon problème?

Merci d'avoir répondu
Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008
>
Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008

j'ai modifié plusieurs fois mai rien à faire j'y arrive pas. Si quelqu'un pouvais m'aider sa m'arrangerais grandement

Merci d'avance