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 |
