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 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
|
Sub Test()
Dim Fe As Worksheet
Dim Plage As Range
'gèle le rafraîchissement de l'écran
Application.ScreenUpdating = False
'défini la plage sur toute la feuille
Set Plage = DefPlage(Worksheets("filtre"))
'filtre pour ne garder que les lignes n'ayant pas "Item retiré"
Plage.AutoFilter 2, "<>Item retiré"
'ajoute une nouvelle feuille
Set Fe = Worksheets.Add
'copie sur la feuille "Feuil2" le résultat du filtrage (cette feuille doit impérativement exister dans le classeur !)
Worksheets("filtre").AutoFilter.Range.EntireRow.Copy Fe.Cells(1, 1)
'suppression du filtre
Plage.AutoFilter
'vide la feuille...
Worksheets("filtre").Cells.Clear
'récupère les valeurs sur la feuille "Feuil2"...
Set Plage = DefPlage(Fe)
'les colle à nouveau sur la feuille "filtre"
Plage.Copy Worksheets("filtre").Cells(1, 1)
Application.DisplayAlerts = False
'supprime la feuille
Fe.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
On Error GoTo Fin
With Fe
Set DefPlage = .Range(.Cells(L, C), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
Exit Function
Fin:
Set DefPlage = Nothing
End Function |
Partager