High-Tech Santé Médecine Droit-Finances

Grippe A

Que dois-je faire ?

Rechercher : dans
Par :

VBA excel problème de copier/coller filtre

Dernière réponse le 4 jui 2008 à 09:31:08 roberto93, le 3 jui 2008 à 12:20:47 
 Signaler ce message aux modérateurs

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

Configuration: Windows 2000
Internet Explorer 6.0

Meilleures réponses pour « VBA excel problème de copier/coller filtre » dans :
VBA et les collections d'objets. VoirVBA et les collections d'objets Quand plusieurs (beaucoup de) contrôles sont mis sur une feuille ou un Userform il est parfois fastidieux d'écrire du code dans chaque évènement des contrôles. Ce Tuto vous permet de traiter vos contrôles comme...
Ubuntu - Un copier coller rapide VoirUn copier-coller ultra-rapide Sous Ubuntu, Linux, il est très simple de faire un copier coller, encore plus simple qu'un “Ctrl + C” “Ctrl + V” : Il suffit de sélectionner le texte (juste le sélectionner) pour le mettre en mémoire puis de...
Posez votre question Répondre

1

lermite222, le 3 jui 2008 à 12:38:58

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+ L'expérience instruit plus sûrement que le conseil. (André Gide)  

   
Répondre à lermite222

2

roberto93, le 3 jui 2008 à 13:33:06

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

   
Répondre à roberto93

3

roberto93, le 3 jui 2008 à 16:00:00

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

   
Répondre à roberto93

4

lermite222, le 4 jui 2008 à 04:45:05

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+ L'expérience instruit plus sûrement que le conseil. (André Gide)  

   
Répondre à lermite222

5

 roberto93, le 4 jui 2008 à 09:31:08

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

   
Répondre à roberto93
Posez votre question Répondre
Ils ont besoin de votre aide