macro de recherche et de copie de valeurs

[bogs]

Bonjour à tous

j'ai un tableau qui contient un nombre important de valeurs sur une feuille. colonnes(Mr, nom, prenom,age,adresse,cp, ville...)

je souhaite grace à une macro VB en fonction de la valeur d'une des colonnes(exemple Mr Ou Mme)que les lignes concernées soient recopiées sur une nouvelle feuille (avec toutes les valeurs) ou je n'aurais que les Mrs, une autre que les Mmes ou que les habitants d'une ville déterminée, les lignes devant se suivrent dans les feuilles de sélection, sans vide. car je les réutiliserais pour faire des menus déroulants spécifiques.
je ne veux pas utiliser les fonctions des cellules (style recherchev) mais bien une macro...merci que je lancerais à l'ouverture du classeur.

j'imagine que vous avez déjà résolu le problème,mais malgrès ce que j'ai cherché sur le site, mes recherches restent infructueuses.
merci.

 

[pat1545.]

Hello,
esaie ceci à adapter
Patrick

Option Explicit
Option Compare Text

Sub Copier_les_cellulesMmeMr() ' copie vers f2-3-4
Dim Plage As Range, Cell As Range, Lastrow As Integer, I As Byte
Dim CellV
With ActiveSheet
Lastrow = .Range('A32767').End(xlUp).Row
For Each Cell In .Range('A2:A' & Lastrow)
CellV = Cell.Value
Select Case CellV
Case 'Mrs'
'If Cell.Value = 'Mrs' Then
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(2).Range('a65536').End(xlUp)(2)
Case 'Mlle'
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(3).Range('a65536').End(xlUp)(2)
Case 'Mme'
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
End Select
Next

End With
End Sub

 

[bogs]

bonjour,
et merci pat 1545.
malheureusement je n'ai pas réussit à faire fonctionner la macro
j'ai rajouté dim Mr...
par contre je ne retrouve pas dans la macro la valeur I definie en début comme as byte ? estce normal ?

 

[bogs]

ci-joint un modele de classeur avec la feuil 1 qui regroupe toutes les données.
et deux exemples de tri en feuil2 et 3

 

[porcinet82]

salut bogs,

tu as oublier de joindre ton fichier, zippé et inférieur à 50ko

@+

 

[bogs]

excusez... le voilà

 

[porcinet82]

re bogs,

tu as encore oublié de mettre le fichier joint. quand tu fais parcourir, tu sélectionnes ton fichier et apres il faut pas oublier de cliquez sur le petit bouton juste a coté ou il a ecrit fichier.

voila @+

 

[bogs]

j'essaie avec des vues :

feuille 1 [file]

feuille 2 [file]

feuille3 [file]


je pense avoir fait la bonne manip à chaque fois :huh:

 

[bogs]

c'est reparti en compressant cette fois
feuil1 feuil2 feuil3

 

[bogs]

j'ai réussi à obtenir ce que je voulais il y avait un petit bug dans la macro proposée ...je l'ai trouvé après qqs recherches.merci à tous.

Option Explicit
Option Compare Text

Sub Copier_les_cellulesMmeMr() ' copie vers f2-3-4
Dim Plage As Range, Cell As Range, Lastrow As Integer, V As Byte
Dim CellV
With ActiveSheet
Lastrow = .Range('A32767').End(xlUp).Row
For Each Cell In .Range('A2:A' & Lastrow)
CellV = Cell.Value
Select Case CellV
Case 'Mr'
'If Cell.Value = 'Mr' Then
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(2).Range('a65536').End(xlUp)(2)
Case 'Mlle'
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(3).Range('a65536').End(xlUp)(2)
Case 'Mme'
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
End Select
Next

End With
End Sub