OVH Cloud OVH Cloud

Filtre par macro

8 réponses
Avatar
Fredo(67)
Bonjour,

J'utilise la macro suivante pour effectuer un tri sur une feuille Excel et =
r=C3=A9cup=C3=A9rer la s=C3=A9lection dans une autre feuille

Sub test()

Application.ScreenUpdating =3D False
Dim Crit=C3=A8Re
Crit=C3=A8Re =3D "Type 1"
Worksheets("Type").Range("C1:k100").Clear
Worksheets("Feuil1").Activate
Range("B4").Select
ActiveSheet.Range("$B$4:$i$1100").AutoFilter Field:=3D2, Criteria1:=3D =
_
Crit=C3=A8Re
Selection.CurrentRegion.Copy
ActiveSheet.Paste Destination:=3DWorksheets("type").Range("C1")
Selection.AutoFilter
Application.CutCopyMode =3D False
Worksheets("FEUIL1").Select
Application.CommandBars("stop recording").Visible =3D False


End Sub

Le "soucis" est qu'il r=C3=A9cup=C3=A8re et colle tout de la feuille de bas=
e
- Les mises en forme conditionnelles
- Les couleurs de texte=20
- Les couleurs de fond de cellule


Y'aurait il moyen qu'il ne r=C3=A9cup=C3=A8re que les valeurs ?

Merci

8 réponses

Avatar
Jacquouille
Bonjour Fredo,
Si tu es content du travail de la macro, tu peux lui laisser faire tout,
puis, in fine, faire un copier-coller / spécial valeur.
Non?
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"Fredo(67)" a écrit dans le message de groupe de discussion :
Bonjour,
J'utilise la macro suivante pour effectuer un tri sur une feuille Excel et
récupérer la sélection dans une autre feuille
Sub test()
Application.ScreenUpdating = False
Dim CritèRe
CritèRe = "Type 1"
Worksheets("Type").Range("C1:k100").Clear
Worksheets("Feuil1").Activate
Range("B4").Select
ActiveSheet.Range("$B$4:$i$1100").AutoFilter Field:=2, Criteria1:= _
CritèRe
Selection.CurrentRegion.Copy
ActiveSheet.Paste Destination:=Worksheets("type").Range("C1")
Selection.AutoFilter
Application.CutCopyMode = False
Worksheets("FEUIL1").Select
Application.CommandBars("stop recording").Visible = False
End Sub
Le "soucis" est qu'il récupère et colle tout de la feuille de base
- Les mises en forme conditionnelles
- Les couleurs de texte
- Les couleurs de fond de cellule
Y'aurait il moyen qu'il ne récupère que les valeurs ?
Merci
Avatar
Fredo(67)
Le mardi 24 septembre 2019 14:46:36 UTC+2, Jacquouille a écrit :
Bonjour Fredo,
Si tu es content du travail de la macro, tu peux lui laisser faire tout,
puis, in fine, faire un copier-coller / spécial valeur.
Non?
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"Fredo(67)" a écrit dans le message de groupe de discussion :
Bonjour,
J'utilise la macro suivante pour effectuer un tri sur une feuille Excel e t
récupérer la sélection dans une autre feuille
Sub test()
Application.ScreenUpdating = False
Dim CritèRe
CritèRe = "Type 1"
Worksheets("Type").Range("C1:k100").Clear
Worksheets("Feuil1").Activate
Range("B4").Select
ActiveSheet.Range("$B$4:$i$1100").AutoFilter Field:=2, Criteria1: = _
CritèRe
Selection.CurrentRegion.Copy
ActiveSheet.Paste Destination:=Worksheets("type").Range("C1")
Selection.AutoFilter
Application.CutCopyMode = False
Worksheets("FEUIL1").Select
Application.CommandBars("stop recording").Visible = False
End Sub
Le "soucis" est qu'il récupère et colle tout de la feuille de b ase
- Les mises en forme conditionnelles
- Les couleurs de texte
- Les couleurs de fond de cellule
Y'aurait il moyen qu'il ne récupère que les valeurs ?
Merci

Salut
Merci pour ta réponse, mais en fait le fait de copier/coller les valeu rs ne supprime pas les mises en formes conditionnelles.
C'est pas que j'en ai beaucoup, mais le fait que chaque tri par ma macro cr éé des MFC sur chacun des onglets des feuilles....
et à force, Excel plante...
De même si j'insère une forme (avec par exemple un texte expliqua nt la procédure de lancement de la macro de tri) cette forme est recop iée dans la feuille de destination...
Avatar
MichD
Bonjour,
Essaie de cette manière :`
'---------------------------------------
Sub test()
Application.ScreenUpdating = False
Dim CritèRe
CritèRe = "Type 1"
With Worksheets("Type")
.Range("C1:k100").Clear
End With
With Worksheets("Feuil1")
With .Range("$B$4:$i$1100")
.AutoFilter Field:=2, _
Criteria1:=CritèRe
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Type").Range("C1")
.AutoFilter
End With
End With
End Sub
'---------------------------------------
MichD
Avatar
MichD
Je n'avais pas lu toute la question
Je propose plutôt ceci :
'---------------------------------------
Sub test()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CritèRe
CritèRe = "Type 1"
With Worksheets("Type")
.Range("C1:k100").Clear
End With
With Worksheets("Feuil1")
With .Range("$B$4:$i$1100")
.AutoFilter Field:=1, _
Criteria1:=CritèRe
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Type").Range("C1")
.AutoFilter
End With
End With
With Worksheets("Type")
With .Range("C1:k100")
.FormatConditions.Delete
.Font.Color = xlAutomatic
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------
MichD
Avatar
MichD
Remplace
.fond.color = xlautomatic
Par
.Interior.Color = xlNone
MichD
Avatar
MichD
ça donne ceci :
'---------------------------------------
Sub test()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CritèRe
CritèRe = "Type 1"
With Worksheets("Type")
.Range("C1:k100").Clear
End With
With Worksheets("Feuil1")
With .Range("$B$4:$i$1100")
.AutoFilter Field:=2, _
Criteria1:=CritèRe
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Type").Range("C1")
.AutoFilter
End With
End With
With Worksheets("Type")
With .Range("C1:k100")
.FormatConditions.Delete
.Interior.Color = xlNone
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------
MichD
Avatar
Fredo(67)
Le mardi 24 septembre 2019 17:07:23 UTC+2, MichD a écrit :
ça donne ceci :
'---------------------------------------
Sub test()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CritèRe
CritèRe = "Type 1"
With Worksheets("Type")
.Range("C1:k100").Clear
End With
With Worksheets("Feuil1")
With .Range("$B$4:$i$1100")
.AutoFilter Field:=2, _
Criteria1:=CritèRe
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Type").Range("C1")
.AutoFilter
End With
End With
With Worksheets("Type")
With .Range("C1:k100")
.FormatConditions.Delete
.Interior.Color = xlNone
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------
MichD

Salut MichD et merci pour ta réponse
Effectivement, cela marche (en adaptant un brin) mais cela rallonge consid érablement la durée d'éxécution de la macro.
Je vais réduire la zone ...
Merci
Avatar
MichD
Essaie ceci : Cela copie seulement les données, cela devrait être plus
court à l'exécution
'-----------------------------------------
Sub test()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CritèRe
CritèRe = "Type 1"
With Worksheets("Type")
.Range("C1:k100").Clear
End With
With Worksheets("Feuil1")
With .Range("$B$4:$i$1100")
.AutoFilter Field:=2, _
Criteria1:=CritèRe
.SpecialCells(xlCellTypeVisible).Copy
Worksheets("Type").Range("C1:k100").PasteSpecial xlPasteValues
Application.CutCopyMode = False
.AutoFilter
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'-----------------------------------------
MichD