Filtrer des données et supprimer le reste

[Nessie]

Bonjour,

Mon titre n'est pas très parlant mais je ne savais pas comment le nommer. Mes excuses par avance.
ALors voilà :
Dans mon fichier excel, J'ai un tableau situé sur une feuille de calcul que je vais appeler Feuil1. Jusqu'ici tout va bien.
Mes 2 premières colonnes se nomment REGION et DEPARTEMENT.
Je dois effectuer des sélections de départements (et donc région) et supprimer les autres qui ne m'intéressent pas. Le seul hic, c'est que je dois faire 60 feuilles de calcul (60 onglets), ayant pour base la même feuille (Feuil1 que je copie et colle) et faire mes sélections sur chaque feuille. Les feuilles présenteront à ma responsable différents catalogues.
Jusqu'à présent, vu que je n'ai pas trouvé le truc qui allait me facilitait la tâche, je faisais un filtre automatique sur les colonnes, je sélectionnais par exemple les départements qui m'intéressaient (ou que je voulais virer), je les copiais et les collais dans une autre feuille (ou je conservais donc les données débarrassées de ce que j'ai supprimé). Mais j'aimerais aller plus vite à partir du tableau complet (que je copie et colle sur 60 feuilles de classeur différentes). Imaginez, faire ça sur 60 feuilles, pour garder seulement 3 ou 4 départements par feuille et donc virer tous les autres...

Y a-t-il un truc qui ferait que je pourrais sélectionner en même temps plusieurs départements et supprimer les lignes qui correspondent aux département que je n'aurais pas retenus ? Je suis sûre que c'est possible... faire un genre de "supprimer tout sauf les départements que je veux garder".

Help, je dois finir ce travail demain et je suis dessus depuis hier soir.....

J'espère avoir été claire

Je précise que je ne suis pas une pro du VBA quand bien ce forum m'a appris tut ce que je sais en VBA access. Je souhaiterais donc au possible une astuce via l'interface classique

 

[Robert]

Re : Filtrer des données et supprimer le reste

Bonjour Nessie, bonjour le forum,


Même si tes explications sont claires, un petit fichier en pièce jointe serait le bienvenu. Sinon on va perdre du temps en propositions qui risquent de ne pas correspondre...

 

[Nessie]

Re : Filtrer des données et supprimer le reste

Bonjour,

Tu as tout à fait raison. J'ai récupéré aujourd'hui le fichier du boulot et il est lourd. Je vais essayer de l'uploader.
Sur 2010, j'arrive à faire ce que je veux mais sur 2003....

 

[flyonets44]

Re : Filtrer des données et supprimer le reste

Bonjour
Voici du code qui réalise le job; à toi de l'adapter à la configuration de ta feuille
Sub FiltreAutoperso()
'1-FILTRER SUR LE CONTENU D UNE CELLULE DANS UNE COLONNE FLA 30.10.07
'2-OPTION 1:COLORIER LES LIGNES VISIBLES
'3-option 2:COPIER LES LIGNES VISIBLES VERS UNE AUTRE FEUILLE
'4-option 2:COPIER LES LIGNES VISIBLES VERS UNE AUTRE FEUILLE
'SUPPRIMER LES LIGNES FILTREES DE LA FEUILLE SOURCE
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim K&, Nbcol&, Vcol&, Choix&, Nomf As String
Dim Actuel As String, Rgf As Range, Rgt As Range, Plage As Range
Actuel = ActiveCell.Value: Nomf = ActiveSheet.Name
Vcol = ActiveCell.Column
K = Cells(65536, Vcol).End(xlUp).Row
Set Plage = Sheets(Nomf).Range("A1").Offset(1).Resize(K, Columns.Count)
Choix = 3 ' OPTION DU FILTRE
Set Rgt = Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0)
Cells(1, Vcol).Select
Selection.AutoFilter
With Sheets(Nomf).Cells(1, Vcol)
.AutoFilter field:=Vcol, Criteria1:=Actuel
Set Rgf = Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase"). _
Rows.Count - 1).SpecialCells(xlCellTypeVisible)
Select Case Choix
Case Is = 1 'marquage le résultat du filtre dans la feuille source
Rgf.Interior.ColorIndex = 36
Case Is = 2 'copie le résultat du filtre vers autre feuille
Rgf.Copy Destination:=Rgt
Case Is = 3 'garde uniquementle résultat du filtre dans la feuille destination
'et Purge le résultat du filtre dans la feuille source
Rgf.Copy Destination:=Rgt
Rgf.ClearContents
End Select
End With
' Suppression du filtre automatique
Selection.AutoFilter
If Choix = 3 Then
Set Plage = Sheets(Nomf).Range("A1").Offset(1).Resize(K, Columns.Count)
Plage.Sort [a1]
End If
Set Rgf = Nothing: Set Rgt = Nothing: Set Plage = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub
Bien cordialement
Flyonets