Re : Extraire des lignes selon critere de date
Merci beaucoup JCGL ... Ta macro fonctionne à merveille.
J'ai en revanche un autre soucis lorsque je rajoute la macro de Gerodep qui me permet de filtrer selon un critère de date .... Macro qui fonctionne d'ailleurs aussi très bien mais qui ne me permet pas ensuite de pouvoir continuer ma macro. Je reste bloquée à
Exit Sub 'sort de la procédure
fin: 'étiquette
MsgBox "Confirmer date !" 'message
GoTo debut 'rouvre la boîte...
Impossible d'activer l'instruction suivante juste après cette macro de filtrage.
Ci dessous detail de la macro..... Merci encore de votre aide.
Option Explicit
Sub DATER_FILTRE_PREALERT()
Dim X As Long
Dim DerL As Long
Dim dt As String 'déclare la variable dt (DaTe)
Dim ct As Date 'déclare la variable ct (CriTère)
Application.ScreenUpdating = 0
Cells.Select
Selection.Copy
ActiveWindow.WindowState = xlMinimized
Windows("MACRO PREALERT.xls").Activate
ActiveWindow.WindowState = xlMaximized
Cells.Select
ActiveSheet.Paste
Range("D6").Select
ActiveWindow.SmallScroll ToRight:=5
Range("P:R,T:X,Y:Y,AE:AE,AH:AK,AS:AT,AV:AV,AX:BA,BB:BE,BF:BF,BH:BO,BR:CK"). _
Select
Range("BR1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Data").Select
DerL = Sheets("Data").Range("A65000").End(xlUp).Row
For X = 1 To 38
Sheets("Data").Range(Cells(1, X), Cells(DerL, X)).TextToColumns Destination:=Cells(DerL + 2, X), DataType:=xlDelimited
Next
Sheets("Data").Rows(DerL + 2 & ":5000").Cut Sheets("Conver").Range("A1")
Sheets("Conver").Select
Range("AA:AA").NumberFormat = "m/d/yyyy"
Range("A1").Select
Range("A1:AL65000").Sort Key1:=Range("AA1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("conver").Select
debut: 'étiquette
'si le filtre automatique est actif, supprime le filtre automatique
Columns("AA:AA").Select
Selection.AutoFilter
If Sheets("conver").FilterMode = True Then Sheets("conver").Range("AA:AA").AutoFilter field:=27, Criteria1:=ct
'définit la variable dt
dt = InputBox("Veuillez indiquer la date au format jj/mm/aa.", "CRITÈRE")
If dt = "" Then Exit Sub 'si la boite n'est pas renseignée, sort de la procédure
On Error GoTo fin 'gestion des erreurs (si la date n'est pas valide), va à l étiquette fin
ct = CDate(dt) 'définit la variable ct
'filtre les données de la première colonne par rapport au critère ct
Sheets("conver").Range("AA1").AutoFilter field:=27, Criteria1:=ct
Exit Sub 'sort de la procédure
Call CREER
fin: 'étiquette
MsgBox "Confirmer date !" 'message
GoTo debut 'rouvre la boîte...
Sheets("conver").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.Columns.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.ColorIndex = 9
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
End Sub
Merci
Zouzou