VBA excel problème de copier/coller filtre

Résolu
roberto93 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention   -  
roberto93 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention   -
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

Réponse 1 / 2
lermite222 Messages postés 8724 Date d'inscription   Statut Contributeur Dernière intervention   1 191
 
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
roberto93 Messages postés 14 Date d'inscription   Statut Membre Dernière intervention  
 
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
0

Discussions similaires

les touches filtres et remanentes
salicia -
kayshar -

18 réponses
ou se trouve les anti spam??
leksa -
riton -

37 réponses
Effet GTA
Kali02 -
chris -

8 réponses
Compter cellules apres un filtre Excel
lgabriel -
12 -

25 réponses
Filtre chronologique Excel TCD
mat20008 -
mat20008 -

4 réponses
EXCEL - NB.SI et Filtre auto.
Ophelie75 -
Vaucluse -

9 réponses