supprimer les lignes en fonction de la valeur d'une cellule

[aud1885]

Bonjour a tous !
Je suis en train de mettre en place un système pour du covoiturage un peu dans l'esprit de covoiturage.com mais au sein d'une entreprise. Le but étant que les personnes qui ont une voiture et qui veulent bien amener des gens au travail s'inscrivent. J'ai plusieurs problèmes mais je vais commencé par le plus important.
J'ai une gfeuille ("liste de passagers") sur laquelle tous les passagers sont référencés. J'ai fait une autre feuille intitulée ("recherchepassager"). J'ai une case intitulée CP ("D16"). Le but est de copier la liste de passagers sur la feuille "recherchepassager" puis de supprimer les lignes pour lesquelles le CP (colonne E) ne correspond pas à la case intitulée CP.
Le problème est que mon code ne fonctionne que si je met une valeur précise dans mon code alors que je veux que l'on compare à chaque fois en fonction de la valeur entrée en "D16". ex de ec que j'ai et qui marche:

Sub recherchepassager()
'
' recherchepassager Macro
    Sheets("liste des passagers").Select
    Range("B2:BS308").Select
    Selection.Copy
    Sheets("Recherchepassager").Select
    Range("B30").Select
    ActiveSheet.Paste
    Range("B30:I30").Select
    Selection.Interior.ColorIndex = 15
    Range("E32").Select
For i = 34 To 400
If ActiveCell.Value > 69100 Or ActiveCell.Value < 69100 Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Next i
Range("B30").Select
End Sub

En gros, à la place de 69100 je veux recherchepassager!"D16" mais visiblement ca ne fonctionne pas et je ne suis même pas sure qu'une telle action soit possible... Après des recherches toutes la journée, je ne trouve rien qui me décoince !!
alors si quelqu'un avait la générosité de m'aider...
Avis à bon entendeur...
Merci d'avance !

 

[aud1885]

Toutes mes excuses ! comme quoi la nuit porte conseil... J'ai trouvé toute seule comme une grande...
j'ai fait :

Sub recherchepassager()
'
' recherchepassager Macro
' Macro enregistrée le 17/07/2007 par POULAT
'

'
    Sheets("liste des passagers").Select
    Range("B2:BS308").Select
    Selection.Copy
    Sheets("Recherchepassager").Select
    Range("B30").Select
    ActiveSheet.Paste
    Range("B30:I30").Select
    Selection.Interior.ColorIndex = 15
    Range("E32").Select
For i = 34 To 400
If ActiveCell.Value > Range("D16").Value Or ActiveCell.Value < Range("D16") Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Next i
Range("B30").Select
reponse = MsgBox("La recherche est terminée. Si le résultat n'est pas satisfaisant : veuillez relancer une recherche avec un critère différent.", vbOKOnly + vbInformation, "Information")

End Sub

Voila !

 

[zeb]

Ligne 18 :heink: [fixed]If ActiveCell.Value > Range("D16" ).Value Or ActiveCell.Value < Range("D16" ) Then[/fixed]En gros :a > b Ou a < b. Tu sais tu peux l'écrire a <> b

Ligne 21 [fixed]ActiveCell.Offset(1, 0).Range("A1" ).Select[/fixed]Keskesékesa ? Pourquoi ce Range(A1) ?

Ligne 8 à 15 : Je hais les Select/Selection/ActiveTruc & autres Copy/Paste/CutCopyMode. (Oui, je sais, c'est l'enregistreur qui te l'a fait)

Ce morceau de code, revu et corrigé (à bien étudier, si tu veux)

Sheets("liste des passagers").("B2:BS308").Copy Destination:=Sheets("Recherchepassager").Range("B30")    
Sheets("Recherchepassager" ).Range("B30:I30" ).Interior.ColorIndex = 15

Et oui, c'est tout

------------------------

Ligne 17 à 23. Supprimer des lignes dans un tableau. (dans Excel en particulier, mais pour tout tableau en général et en tout langage)
Soit le tableau suivant :
[fixed]1. AAAA
2. BBBB
3. CCCC[/fixed]L'algorithme suivant est faux :

Pour i de 1 à 3
    Si condition Alors Supprimer Ligne i

En effet, supposons que la condition nous fasse vouloir supprimer les lignes AAAA et BBBB.
Déroulons le code:
i=1. La condition est vrai. Supprimons la ligne 1 :[fixed]1. BBBB
2. CCCC[/fixed]
i=2. Et hop, première erreur, on vient de rater la ligne des BBBB !. Pour CCCC la condition n'est pas remplie.
i=3. Et hop, encore une erreur, il n'y a plus de ligne 3. Erreur ! (Pas d'erreur sous excel, le tableau fait toujours 65536 lignes)

La solution : Partir du bas du tableau et remonter

Pour i de 3 à 1
    Si condition Alors Supprimer Ligne i

Traduit en VB :

For i = 400 To 34 Step -1
    If Range("E" & i).Value <> Range("D16" ).Value Then Rows(i).Delete
Next i

------------------------

Proposition finale.
Tu peux te l'approprier complètement juste en comprenant tout ce code

Sub recherchepassager()
    ' (c) aud1885 (+ un peu de PPC)
    
    Sheets("liste des passagers").("B2:BS308").Copy Destination:=Sheets("Recherchepassager").Range("B30").    
    Sheets("Recherchepassager").Range("B30:I30").Interior.ColorIndex = 15
    
    For i = 400 To 34
        If Sheets("Recherchepassager").Range("E" & i).Value <> Sheets("Recherchepassager").Range("D16").Value Then Rows(i).Delete        
    Next i
    
    reponse = MsgBox("La recherche est terminée. Si le résultat n'est pas satisfaisant, " & _
                     "veuillez relancer une recherche avec un critère différent.", _
                     vbOKOnly + vbInformation, "Information")
End Sub

 

[aud1885]

Bonjour ! Déja merci pour tes réponses !!
tu m'as dit de faire ca pour mon filtrage des lignes
Traduit en VB :

For i = 400 To 34 Step -1
    If Range("E" & i).Value <> Range("D16" ).Value Then Rows(i).Delete
Next i

Maintenant je veux ajouter un filtrage dans cette même macro pour filtrer mes colonnes en fonction de la valeur de E17. (cest pour filtrer selon la date qui est en en tête des colonnes) Si je fais ca ca ne marche pas ... Sais tu où se trouve l'erreur?

For n = k To bv
    If Range("33" & n).Value <> Range("E17").Value Then Columns(n).Delete
Next n

 

[Freeman23]

Salut aud1885,

A mon avis c'est ton test qui est faux. Vu que tu parcours les colonnes il est plus difficile d'utiliser Range.

Si on prends ton test dans un cas concret, par exemple n = 3 ca donne

If Range("333").value

Donc tu devrais voir l'erreur, dans ce cas précis je te conseille de jeter un coup d'oeil à Cells.