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 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
|
Sub Filtrer()
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Colonne As Integer
Dim Critere As String
Dim I As Integer
Dim J As Integer
Dim K As Integer
'demande le critère par sélection d'une cellule
On Error Resume Next 'évite l'erreur du bouton Annuler
Set Cel = Application.InputBox("Sélectionnez une cellule pour le filtrage !", "Choix.", , , , , , 8)
'si pas de sélection, fin
If Cel Is Nothing Then Exit Sub
'si plus d'une cellule, fin
If Cel.Cells.Count > 1 Then Exit Sub
'défini le critère de filtrage et le numéro de la colonne sur laquelle apliquer le filtre
Critere = Cel.Value
Colonne = Cel.Column
'affecte la feuille "Saisie" à la variable
Set Fe = Worksheets("Saisie")
'défini la plage pour le filtrage
With Fe
Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 7).End(xlUp))
End With
'gèle la mise à jour de l'écran
Application.ScreenUpdating = False
With Worksheets("Formulaire")
'vide les cellules de leurs contenu
.Range("C11:W22").ClearContents
'défusionne la plage
.Range("J6:Q6").UnMerge
'vide le contenu
.Range("J6").ClearContents
'refusionne
.Range("J6:Q6").Merge '<-- il faut autant que possible éviter les fusions si ce n'est pas absolument nécessaire !!!
End With
'pour commencer à la bonne ligne
J = 10
'applique le filtre
Plage.AutoFilter Colonne, Critere
'parcour la plage filtrée à la recherche des lignes visibles
For I = 2 To Plage.Rows.Count
If Plage.Rows(I).EntireRow.Hidden = False Then
'incrémente pour inscrire
J = J + 1
'évite de copier pour ne pas embarquer le formatage
With Worksheets("Formulaire")
'si la date n'a pas encore été entrée
If .Range("J6") = "" Then .Range("J6") = Fe.Range("C" & I)
.Range("C" & J) = Fe.Range("E" & I)
.Range("D" & J) = Fe.Range("F" & I)
.Range("E" & J) = Fe.Range("G" & I)
.Range("G" & J) = Fe.Range("I" & I)
.Range("H" & J) = Fe.Range("J" & I)
.Range("I" & J) = Fe.Range("K" & I)
.Range("J" & J) = Fe.Range("L" & I)
.Range("K" & J) = Fe.Range("M" & I)
.Range("M" & J) = Fe.Range("O" & I)
.Range("N" & J) = Fe.Range("P" & I)
.Range("O" & J) = Fe.Range("Q" & I)
.Range("P" & J) = Fe.Range("R" & I)
.Range("Q" & J) = Fe.Range("S" & I)
.Range("S" & J) = Fe.Range("U" & I)
.Range("T" & J) = Fe.Range("V" & I)
.Range("U" & J) = Fe.Range("W" & I)
.Range("V" & J) = Fe.Range("X" & I)
.Range("W" & J) = Fe.Range("Y" & I)
End With
End If
Next I
'supprime le filtrage
Plage.AutoFilter
'rafraîchi l'écran
Application.ScreenUpdating = True
End Sub |
Partager