Filtre par macro

Le
Fredo(67)
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 bas=
e
- 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
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Jacquouille
Le #26526593
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
Fredo(67)
Le #26526594
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...
MichD
Le #26526608
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
MichD
Le #26526607
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
MichD
Le #26526610
Remplace
.fond.color = xlautomatic
Par
.Interior.Color = xlNone
MichD
MichD
Le #26526609
ç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
Fredo(67)
Le #26526611
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
MichD
Le #26526616
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
Publicité
Poster une réponse
Anonyme