Création macro filtrant uniquement les dates supérieur à aujourd'hui
Bonjour,
Je souhaiterais créer un filtre à partir de la cellule G8 à la dernière cellule ayant une valeur uniquement sur les dates supérieur à aujourd'hui.
J'ai fait cette macro , ça fonctionne bien jusqu'à :
"'Filtrer sur date > aujourd'hui
dt = DateSerial(Day(Date), Month(Date), Year(Date))
MaFeuille.Range("G7:G500" & NbLigne).AutoFilter Field:=1, Criteria1:=">=" & dt, Operator:=xlAnd"
En effet, le filtre ne fonctionne pas je ne sais pas pourquoi, j'ai cherché partout.
Merci de votre aide.
Sub Envoyer_un_tabeau_OK_AvecMessage_2()
'
'Déclaration de la variable
Dim MaFeuille As Worksheet
Dim NbLigne As Integer
Dim rng As Range
Dim emailBody As String
Dim strDate As String
'Affectation des variables
Set MaFeuille = ThisWorkbook.Sheets("Réunion de perf")
'Désactivation du raffraichissement de l'écran
Application.ScreenUpdating = False
'On calcule le nombre de lignes à prendre
NbLigne = MaFeuille.Range("F" & MaFeuille.Rows.Count).End(xlUp).Row
'Supprimer tous les filtres pour s'assurer que nous partons d'un état non filtré
MaFeuille.AutoFilterMode = False
'Filtrer la colonne C pour n'inclure que les cellules vides et celles contenant "En attente"
Set rng = MaFeuille.Range("F7:F" & NbLigne)
rng.AutoFilter Field:=1, Criteria1:="=", Operator:=xlOr, Criteria2:="En Attente"
'Filtrer sur date > aujourd'hui
dt = DateSerial(Day(Date), Month(Date), Year(Date))
MaFeuille.Range("G7:G500" & NbLigne).AutoFilter Field:=1, Criteria1:=">=" & dt, Operator:=xlAnd
'On selectionne la plage à copier (après le filtrage)
MaFeuille.Range("B5:g38" & NbLigne).SpecialCells(xlCellTypeVisible).Select
'Avec l'objet Mail
ActiveWorkbook.EnvelopeVisible = True
With Selection.Parent.MailEnvelope
With .Item
.To = MaFeuille.Range("B3").Value
.CC = MaFeuille.Range("C3").Value
.Subject = MaFeuille.Range("B5").Value
'Initialisation du corps de l'e-mail
emailBody = "Bonjour," & vbCrLf & vbCrLf & _
"Je souhaiterais aborder ce(s) différent(s) lors de la ou les prochaines réunions de performance hebdomadaire. Vous pouvez vous rendre sur le fichier ici:" & vbCrLf & vbCrLf
'Ajouter le contenu du tableau au corps de l'e-mail
emailBody = emailBody & Selection.Parent.MailEnvelope.Item.Body
'Ajouter le corps de l'e-mail au message
.Body = emailBody
.Send
End With
End With
'Réactiver les messages d'alerte
Application.DisplayAlerts = True
'Supprimer le filtre
MaFeuille.AutoFilterMode = False
'Réactiver le raffraichissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
Essayez en corrigeant déjà ces trois points :
- déclarez la variable dt : Dim dt as Date
- remplacez les espaces par des underscore (ou par ce que vous voulez) dans les noms d'onglets : Réunion_de_perf
- donnez d'abord le focus à votre feuille :
Set rng = MaFeuille.Range("F7:F" & NbLigne)
MaFeuille.Activate
bonjour, on filtre sur les 2 colonnes, comme ceci
Set rng = MaFeuille.Range("F7:G" & NbLigne)
rng.AutoFilter Field:=1, Criteria1:="=", Operator:=xlOr, Criteria2:="En Attente"
rng.AutoFilter 2, ">=" & Format(Date, "mm/dd/yyyy")
Merci à tous les deux pour vos réponses!! Ca fonctionne c'est super! :) Je vous souhaite une agréable journée