VBA excel problème de copier/coller filtre
Résolu/Fermé
roberto93
Messages postés
14
Date d'inscription
vendredi 27 juin 2008
Statut
Membre
Dernière intervention
7 juillet 2008
-
3 juil. 2008 à 12:20
roberto93 Messages postés 14 Date d'inscription vendredi 27 juin 2008 Statut Membre Dernière intervention 7 juillet 2008 - 4 juil. 2008 à 09:31
roberto93 Messages postés 14 Date d'inscription vendredi 27 juin 2008 Statut Membre Dernière intervention 7 juillet 2008 - 4 juil. 2008 à 09:31
A voir également:
- Vous pouvez seulement copier des données filtrées vers la feuille active
- Excel reporter des données sur une autre feuille avec conditions - Forum Excel
- Feuille de score belote excel - Forum Excel
- Comment copier une vidéo youtube - Guide
- Feuille diddl la plus rare ✓ - Forum Graphisme
- Feuille de pointage excel - Télécharger - Tableur
2 réponses
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 191
4 juil. 2008 à 04:45
4 juil. 2008 à 04:45
une solution...
A+
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+
4 juil. 2008 à 09:31
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