Macro : suppression ligne sur base de la date
Bonjour,
Je suis nouveau dans la programmation, je suis inscrit dans une petite formation pour adulte.
Et je bloque.
J'ai créé une macro qui va extraire des données d'un autre fichiers et qui les copies dans un autre (avec des filtres, mise en page).
Maintenant j'aimerais rajouter dans cette macro qu'elle me supprime toutes les lignes qui sont différentes de la date du jour.
J'arrive à le faire pour des lignes avec blanc (enfin je crois)
Code:
1
2
3
4
5
6
7
| Application.ScreenUpdating = False
For i = Range("A65535").End(xlUp).Row To 1 Step -1
If Cells(i, 7).Value = "" Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True |
Mais avec la date, je ne trouve pas.
C'est la première question :)
Un grand merci de votre aide.
JE vous joins aussi le fichier
Exporter et supprimer les lignes répondant à des critères
Bonjour,
Citation:
C'est presque cela, en fait dans la macro, il ne me laisse que les dates du jour, alors que je voudrais l'inverse.
A moins que nous ne parlions pas la même langue, il me semble que c'est exactement ce que tu as demandé
Citation:
Maintenant j'aimerais rajouter dans cette macro qu'elle me supprime toutes les lignes qui sont différentes de la date du jour.
Voici une procédure basée sur la méthode AdvancedFilter qui exporte les données vers la feuille nommée Export et qui ensuite détruit les mêmes lignes de la feuille nommée db
Les dates à contrôler dans cet exemple se trouve en colonne I, et la formule contenant les critères va se placer 2 colonnes à droite de la plage des données qui doit avoir la première ligne avec les étiquettes de colonnes
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
| Sub CopyAndDeleteByAdvancedFilter()
' Déclaration des variables
Const myFormula As String = "=I2<>TODAY()" ' Critère calculé
Dim rngSource As Range, rngTarget As Range, rngCriteria As Range, TypeAction As Integer
' Attribution des références aux variables objets
With ThisWorkbook
Set rngSource = .Worksheets("db").Range("A1").CurrentRegion
Set rngTarget = .Worksheets("Export").Range("A1")
End With
With rngSource: Set rngCriteria = .Offset(columnoffset:=.Column + .Columns.Count).Resize(2, 1): End With
' Placement de la formule dans la zone des critères
With rngCriteria: .Cells(1) = "formula": .Cells(2) = myFormula: End With
' Exportation et destruction des lignes répondant aux critères avec la méthode AdvancedFilter
rngTarget.Worksheet.Cells.Clear ' Efface la feuille de la zone cible
For TypeAction = 2 To 1 Step -1 ' Type action = valeur des constantes xlFilterAction pour argument nommé Action
With rngSource
.AdvancedFilter TypeAction, rngCriteria, rngTarget
If TypeAction = xlFilterInPlace Then
On Error Resume Next
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Worksheet.ShowAllData
On Error GoTo 0
End If
End With
Next
rngCriteria.Clear: Set rngSource = Nothing: Set rngTarget = Nothing: Set rngCriteria = Nothing
End Sub |
Si maintenant ta demande est l'inverse, il faut changer le critère calculé par
ou
