problème avec boucle wend

[David]

Bonjour le forum
Voici un extrait de code qui me permet de parcourir des éléments situés en colonne 1 d'une feuille pour ensuite les dispatcher dans d'autres feuilles.
Le problème(eh oui, il y en a un), c'est que la procédure me parcours l'ensemble des cellules 1 fois et donc, comme vous vous en doutez certainement, si j'ai 50 lignes, 15 titi et 35 toto, je n'aurai qu'un titi dans la feuille titi et, pas un de plus ni dans une autre feuille car la boucle ne se fait pas avec next cellule
Je ne sais donc pas quoi utiliser pour qu'il me parcours l'ensemble des cellules de ma colonne
Je vous remercie

Sub compte()
Dim cpt As Integer
Dim plage As Range
Dim ligne As Range

Sheets("LISTE ").Select
Set ligne = Range("a2:c2")
Set plage = Range("a2", [a2].End(xlDown))
nbcellule = plage.Count

For Each cellule In plage
If ActiveCell.Value = "titi" Then
ligne.Rows(ligne.Row).Copy
Sheets("titi").Select
ActiveSheet.Paste
selection.Offset(1, 0).Select
End If
Sheets("liste ").Select
Application.CutCopyMode = False
selection.Offset(1, 0).Select
If ActiveCell.Value = "toto" Then
selection.entirerow.copy
Sheets("toto").Select
ActiveSheet.Paste
selection.Offset(1, 0).Select
Sheets("liste ").Select
Application.CutCopyMode = False
selection.Offset(1, 0).Select
End If
Next cellule
End Sub

 

[Pascal76]

Bonjour

Au lieu de

If ActiveCell.Value = "titi" then

et

If ActiveCell.Value = "toto" Then

il faut

If cellule.value = "titi" then

et

If cellule.value = "titi" then

Sinon dans ta macro tu ne testes que ta cellule active (ActiveCell

Bon courage

Pascal

 

[David]

Bonjour Pascal76

Super cool, ça marche
Je te remercid
Bonne soirée

 

[Yeahou]

Bonjour david, pascal76, le forum

David, j'ai repris ton code pour le simplifier un peu, celui la fait la même chose sans sélection et sans répétition.

Cordialement, A+

Sub compte()
Dim Plage As Range
Dim Cellule As Range

With Sheets("LISTE ")
Set Plage = .Range("A2:" & .Range("A2").End(xlDown).Address)
For Each Cellule In Plage
If Cellule.Value = "titi" Or Cellule.Value = "toto" Then
Cellule.EntireRow.Copy Destination:=Sheets(Cellule.Value).Range("A65536").End(xlUp).Offset(1, 0)
End If
Next Cellule
End With
End Sub

 

[@+Thierry]

Bonsoir Yeahou, Pascal, David

Et pour mettre les points sur les "i".....

Sheets("LISTE ").Select
Set ligne = Range("a2:c2")
Set plage = Range("a2", [a2].End(xlDown))
nbcellule = plage.Count

Surtout :
Set plage = Range("a2", [a2].End(xlDown))

"va dé rétro captain crochet !!! et autre [a2] !!!!!"

mais bon nous avons des adeptes du capitaine [C] dans XLD !!! lol

Bon je ne fais que passer !!!
Sinon Yahoo !!!! Oups Yeahou !!! lol
@+Thierry

 

[David]

Merci pour cette information