Discussion :

[67jero]

Bonjour,

J'ai un souci concernant le filtre automatique, je pense que vous allez trouver cela d'une simplicité enfantine mais je souhaiterais utiliser comme critère de sélection tout ce qui est avant la date du jour (et non pas que la date-1) en fait je souhaiterais que les deux lignes grisées soient supprimées de l'onglet "bd" mais rajouté dans l'onglet "Archives"
Pour info, je vous transmets le code que j'ai mis sur mon fichier excel ci-joint, je trouve qu'il ne fonctionne pas toujours de façon très fiable, est ce normal ou est il truffé d'erreur ?
Merci d'avance de votre intérêt.

[jfontaine]

pour ajouter des intervalles a une date, tu peux utiliser l'instruction DateAdd

dans ton cas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("bd").Range("a1").AutoFilter Field:=7, Criteria1:=DateAdd("d", -1, Date)

[67jero]

Je suis désolé mais je ne capte pas vraiment la fonction DateAdd, je recherche simplement le critère à mettre pour effectuer un filtre personnalisé de toutes les dates infèrieures à la date du jour.

Merci beaucoup...

[jfontaine]

Essai comme ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("bd").Range("a1").AutoFilter Field:=7, Criteria1:= "<"  & Date

evidemment, il faut que la colonne 7 soit sous un format date reconnu

[Fvandermeulen]

Salut, (salut jfontaine)
Au vu de ce que tu veux finalement faire je pense que ce code doit te convenir...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Historisation()
 
Dim DerLigS As Long, DerLigC 'Variable pour récupérer la dernière ligne remplie, S pour Source et C pour Cible
Dim r As Long 'Variable pour la boucle
Dim LaDate As Date 'Variable pour déterminé la cale haute des dates à "transférer"
 
LaDate = Date - 1 'Défini la cale haute (date du jour -1)
DerLigS = Sheets("Bd").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
DerLigC = Sheets("archives").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
'Boucle pour vérifier chaque cellule de la colonne G (à l'envers car suppression de ligne)
For r = DerLigS To 2 Step -1 'Jusque 2 car titre, step-1 car si ordre normal et suppression on "oublie" des lignes
    If Sheets("bd").Cells(r, 7) < LaDate Then 'Vérifie si le contenu de la cellule est < que la date du jour-1 (via variable LaDate)
        DerLigC = DerLigC + 1 'On incrémente la ligne Cible, donc premier Paste sur ligne 2
        Sheets("bd").Rows(r).Copy Destination:=Sheets("archives").Cells(DerLigC, 1) 'On copie l'ensemble de la ligne
        Sheets("bd").Rows(r).Delete 'On supprime la ligne copiée
    End If
Next r 'Passe à la ligne suivante
End Sub

A+

[67jero]

Pour jfontaine, je crois que tu as raison ce doit être une histoire de format reconnu donc si je reste sur cette solution je ferais les recherches adéquates, et encore un grand merci...

Un grand merci à toi également Fvandermeulen pour ce qui est des dates c'est parfait par contre pour mon projet c'est un peu plus compliqué car il implique d'autres sélections à savoir lorsque la colonne "I" contient quelque chose mais que la colonne "L" ne contient rien je ne dois pas archiver mais par contre lorsque la colonne"I" et la colonne "L" contiennent quelque chose je dois archiver et également lorsque les deux colonnes "I" et "L" ne contiennent rien je dois également archiver, le tout bien sur avec la date -1 en colonne "G". Et vu le code que tu m'as envoyé je vais avoir un mal de tête avant de pouvoir l'adapter...

[Fvandermeulen]

Re,
Ce forum existe justement pour éviter des maux de tête

Voici le code avec le controle sur colonne I et L
C'est pas le plus "propore" mais je crois que tu comprendra aisément.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Historisation()
 
Dim DerLigS As Long, DerLigC 'Variable pour récupérer la dernière ligne remplie, S pour Source et C pour Cible
Dim r As Long 'Variable pour la boucle
Dim LaDate As Date 'Variable pour déterminé la cale haute des dates à "transférer"
Dim TagControl As Byte
 
LaDate = Date - 1 'Défini la cale haute (date du jour -1)
DerLigS = Sheets("Bd").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
DerLigC = Sheets("archives").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
'Boucle pour vérifier chaque cellule de la colonne G (à l'envers car suppression de ligne)
For r = DerLigS To 2 Step -1 'Jusque 2 car titre, step-1 car si ordre normal et suppression on "oublie" des lignes
    If Sheets("bd").Cells(r, 9) = "" And Sheets("bd").Cells(r, 12) <> "" Or Sheets("bd").Cells(r, 9) <> "" And Sheets("bd").Cells(r, 12) = "" Then TagControl = 1
        If Sheets("bd").Cells(r, 7) < LaDate And TagControl = 0 Then 'Vérifie si le contenu de la cellule est < que la date du jour-1 (via variable LaDate)
            DerLigC = DerLigC + 1 'On incrémente la ligne Cible, donc premier Paste sur ligne 2
            Sheets("bd").Rows(r).Copy Destination:=Sheets("archives").Cells(DerLigC, 1) 'On copie l'ensemble de la ligne
            Sheets("bd").Rows(r).Delete 'On supprime la ligne copiée
            TagControl = 0 'réinitialise le controle de "remplissage"
        End If
Next r 'Passe à la ligne suivante
End Sub

A+