Nettoyage et simplification de macro

Le
rthompson
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19435501
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
MichDenis
Le #19435471
Dans la procédure, après que tu auras testé, il manque
au moins une ligne de code au début : On error resume next
car la méthode SpecialCells provoque une erreur si aucune
ligne n'était visible après le filtre (pas d'enregistrements trouvés)


"MichDenis" #
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
rthompson
Le #19435961
Bonjour MichDenis

Merci pour ce complément d'information

Et merci pour le code

Je ne suis pas fanatique des autofiltre
Mais, ceci étant dis, cela fonctionne impecablement bien

A bientôt

Rex


"MichDenis"
Dans la procédure, après que tu auras testé, il manque
au moins une ligne de code au début : On error resume next
car la méthode SpecialCells provoque une erreur si aucune
ligne n'était visible après le filtre (pas d'enregistrements trouvés)


"MichDenis" discussion :
#
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" groupe de
discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx



MichDenis
Le #19435941
En jetant un oeil rapide à la procédure,

Tu devras ajouter le .ACTVATE afin de t'assurer que [C12] et [D12] fassent
référence aux cellules de la feuille "Sales" sinon tu risques d'avoir de drôle de résultat
pour ton filtre.
L'autre alternative est de mettre devant ces 2 cellules le nom de la feuille comme ceci :
Sheets("Sales").[C12] et Sheets("Sales").[C12]

With Sheets("Sales")
.Activate 'AJOUTER
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1




"rthompson" discussion : #
Bonjour MichDenis

Merci pour ce complément d'information

Et merci pour le code

Je ne suis pas fanatique des autofiltre
Mais, ceci étant dis, cela fonctionne impecablement bien

A bientôt

Rex


"MichDenis"
Dans la procédure, après que tu auras testé, il manque
au moins une ligne de code au début : On error resume next
car la méthode SpecialCells provoque une erreur si aucune
ligne n'était visible après le filtre (pas d'enregistrements trouvés)


"MichDenis" discussion :
#
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" groupe de
discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx



rthompson
Le #19436401
C'est marrant

Tant que je n'avais pas fermé le fichier cela fonctionnat

Mais maintenant que je l'ai fermé et réouvert
En effet il plante

Donc j'ai ajouter et cela fonctionne à nouveau
Même après fermeture et réouverture

A mon avis Excel garde certain truc en mémoire tant que le fichier reste
ouvert


Enfin

Maintenant j'ai un autre souci
Et je crois que c'est un gros

Mon PC vient de ralentir de façon considérable (pas uniquement en Excel,
mais tous mes programmes)

Même après un reboot

A première vue pas de virus

Je cherche

A bientôt

Rex



"MichDenis"
En jetant un oeil rapide à la procédure,

Tu devras ajouter le .ACTVATE afin de t'assurer que [C12] et [D12] fassent
référence aux cellules de la feuille "Sales" sinon tu risques d'avoir de
drôle de résultat
pour ton filtre.
L'autre alternative est de mettre devant ces 2 cellules le nom de la
feuille comme ceci :
Sheets("Sales").[C12] et Sheets("Sales").[C12]

With Sheets("Sales")
.Activate 'AJOUTER
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1




"rthompson" groupe de
discussion : #
Bonjour MichDenis

Merci pour ce complément d'information

Et merci pour le code

Je ne suis pas fanatique des autofiltre
Mais, ceci étant dis, cela fonctionne impecablement bien

A bientôt

Rex


"MichDenis"
Dans la procédure, après que tu auras testé, il manque
au moins une ligne de code au début : On error resume next
car la méthode SpecialCells provoque une erreur si aucune
ligne n'était visible après le filtre (pas d'enregistrements trouvés)


"MichDenis" discussion :
#
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" groupe de
discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine
de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx






MichDenis
Le #19436381
ce dont je t'ai fait ajouté permet d'utiliser des références
à des plages de cellules sans faire mentionner à la feuille
car par défaut, ces cellules [C12] et [D12] recherche
l'information sur la feuille active.

Sans utiliser la ligne ".activate", il se peut très bien qu'une
autre feuille soit active au lancement de la macro et là
ce n'est pas une surprise si le code plante !

Cela n'a rien à voir avec le ralentissement général de ton PC.

Peut-être un Virus, Ver, SpyWare ?



"rthompson" discussion :
C'est marrant

Tant que je n'avais pas fermé le fichier cela fonctionnat

Mais maintenant que je l'ai fermé et réouvert
En effet il plante

Donc j'ai ajouter et cela fonctionne à nouveau
Même après fermeture et réouverture

A mon avis Excel garde certain truc en mémoire tant que le fichier reste
ouvert


Enfin

Maintenant j'ai un autre souci
Et je crois que c'est un gros

Mon PC vient de ralentir de façon considérable (pas uniquement en Excel,
mais tous mes programmes)

Même après un reboot

A première vue pas de virus

Je cherche

A bientôt

Rex



"MichDenis"
En jetant un oeil rapide à la procédure,

Tu devras ajouter le .ACTVATE afin de t'assurer que [C12] et [D12] fassent
référence aux cellules de la feuille "Sales" sinon tu risques d'avoir de
drôle de résultat
pour ton filtre.
L'autre alternative est de mettre devant ces 2 cellules le nom de la
feuille comme ceci :
Sheets("Sales").[C12] et Sheets("Sales").[C12]

With Sheets("Sales")
.Activate 'AJOUTER
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1




"rthompson" groupe de
discussion : #
Bonjour MichDenis

Merci pour ce complément d'information

Et merci pour le code

Je ne suis pas fanatique des autofiltre
Mais, ceci étant dis, cela fonctionne impecablement bien

A bientôt

Rex


"MichDenis"
Dans la procédure, après que tu auras testé, il manque
au moins une ligne de code au début : On error resume next
car la méthode SpecialCells provoque une erreur si aucune
ligne n'était visible après le filtre (pas d'enregistrements trouvés)


"MichDenis" discussion :
#
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" groupe de
discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine
de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx






rthompson
Le #19441161
Merci pour ce complément d'information

Pour le ralentiseur, je cherche

J'ai fait un défrag etc cela va un peu mieux mais pas terrible

Mes anti virus, ParFeu etc sont à jour donc .............

Il a peut-être décider de prendre sa retraite ;-(((
Ou du moins de se la couler douce


A bientôt

Rex


"MichDenis"
ce dont je t'ai fait ajouté permet d'utiliser des références
à des plages de cellules sans faire mentionner à la feuille
car par défaut, ces cellules [C12] et [D12] recherche
l'information sur la feuille active.

Sans utiliser la ligne ".activate", il se peut très bien qu'une
autre feuille soit active au lancement de la macro et là
ce n'est pas une surprise si le code plante !

Cela n'a rien à voir avec le ralentissement général de ton PC.

Peut-être un Virus, Ver, SpyWare ?



"rthompson" groupe de
discussion :
C'est marrant

Tant que je n'avais pas fermé le fichier cela fonctionnat

Mais maintenant que je l'ai fermé et réouvert
En effet il plante

Donc j'ai ajouter et cela fonctionne à nouveau
Même après fermeture et réouverture

A mon avis Excel garde certain truc en mémoire tant que le fichier reste
ouvert


Enfin

Maintenant j'ai un autre souci
Et je crois que c'est un gros

Mon PC vient de ralentir de façon considérable (pas uniquement en Excel,
mais tous mes programmes)

Même après un reboot

A première vue pas de virus

Je cherche

A bientôt

Rex



"MichDenis"
En jetant un oeil rapide à la procédure,

Tu devras ajouter le .ACTVATE afin de t'assurer que [C12] et [D12]
fassent
référence aux cellules de la feuille "Sales" sinon tu risques d'avoir de
drôle de résultat
pour ton filtre.
L'autre alternative est de mettre devant ces 2 cellules le nom de la
feuille comme ceci :
Sheets("Sales").[C12] et Sheets("Sales").[C12]

With Sheets("Sales")
.Activate 'AJOUTER
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1




"rthompson" groupe de
discussion : #
Bonjour MichDenis

Merci pour ce complément d'information

Et merci pour le code

Je ne suis pas fanatique des autofiltre
Mais, ceci étant dis, cela fonctionne impecablement bien

A bientôt

Rex


"MichDenis"
Dans la procédure, après que tu auras testé, il manque
au moins une ligne de code au début : On error resume next
car la méthode SpecialCells provoque une erreur si aucune
ligne n'était visible après le filtre (pas d'enregistrements trouvés)


"MichDenis" discussion :
#
Bonjour RThompson,

Le code est correct.

Cependant, je t'ai fait une version utilisant le filtre automatique
dans la première section. Ce devrait être plus rapide !
Je n'ai rien testé... je n'ai pas cet environnement (fichier)
Tu pourrais avoir à faire quelques ajustements !

'--------------------------------------------
Sub Periode_Visible()
Application.ScreenUpdating = False
With Sheets("Sales")
With .Range("Sales_invoice_date")
.EntireRow.Hidden = False
.AutoFilter Field:=1, Criteria1:="<" & [C12] * 1, _
Operator:=xlOr, Criteria2:=">" & [D12] * 1
.SpecialCells(xlCellTypeVisible).EntireRow.Hidden = True
.AutoFilter
End With
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------




"rthompson" de
groupe de
discussion :
Bonjour à toutes et tous

Pas de soucis (cette fois-ci)

Juste une petite demande de simplification de code

Je suis certain qu'il y a moyen de simplifier le code ci-dessous

La raison étant que je vais reproduire cette macro pour une quarantaine
de
filtres différents


Un grand merci à vous et à bientôt

Rex


xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Periode_Visible()
Application.ScreenUpdating = False
Sheets("Sales").Select
Range("Sales_invoice_date").EntireRow.Hidden = False
For Each c In Range("Sales_invoice_date")
If c < [C12] Or c > [D12] Then c.EntireRow.Hidden = True
Next
With Worksheets("Consultation")
With .Range("A1:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.Clear
With Worksheets("Sales")
With .Range("A20:A" & .Range("A65536").End(xlUp).Row)
.EntireRow.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Consultation").Range("A20")
End With
End With
End With
End With
Sheets("Consultation").Select
Range("D7").Select
Application.ScreenUpdating = True
End Sub

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx









Publicité
Poster une réponse
Anonyme