Copie ligne si vrai

[nypon]

Bonsoir,

Je suis débutant en VBA et je cherche à réaliser quelque chose de simple :

Je voudrais copier les lignes qui ont une valeur VRAI dans une colonne, dans une autre feuille.

Voici un fichier exemple : ICI

Est-ce que quelqu'un pourrait m'aider ?

merci bien,

cordialement,

 

[2passage]

Re : Copie ligne si vrai

Bonjour,

Voici une macro qui fonctionne

Sub SelVrai()
Dim selstr As String
For Each ligne In ActiveSheet.Range("A1:A" & Range("A65536").End(xlUp).Row).Rows
If Cells(ligne.Row, 2).Text = "VRAI" Then
    If selstr <> "" Then
        selstr = selstr & "," & ligne.Row & ":" & ligne.Row
    Else
        selstr = ligne.Row & ":" & ligne.Row
    End If
End If
Next
Range(selstr).Copy Destination:=Sheets("Feuil2").Range("A1")
End Sub

C'est du recyclage mais ça marche
@+

 

[nypon]

Re : Copie ligne si vrai

Bonjour et merci pour la réponse.

cependant quand j'exécute la macro, il me dit que la méthode Range de l'objet global n'existe pas.

savez-vous pourquoi ?

 

[ROGER2327]

Re : Copie ligne si vrai

Re...

Cette procédure fonctionne parfaitement dans votre classeur à condition de déclarer toutes les variables si vous écrivez Option Explicit en tête de module.​

ROGER2327
#2208
__
__________________
Bonjour à 2passage

 

[pierrejean]

Re : Copie ligne si vrai

bonjour nypon

Salut ROGER

La macro fonctionne a partir de la Feuil1
Pour qu'elle fonctionne partout je suggere

Sub SelVrai()
Dim selstr As String
For Each ligne In Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A65536").End(xlUp).Row).Rows
If Sheets("Feuil1").Cells(ligne.Row, 2).Text = "VRAI" Then
    If selstr <> "" Then
        selstr = selstr & "," & ligne.Row & ":" & ligne.Row
    Else
        selstr = ligne.Row & ":" & ligne.Row
    End If
End If
Next
Sheets("Feuil1").Range(selstr).Copy Destination:=Sheets("Feuil2").Range("A1")
End Sub

 

[ROGER2327]

Re : Copie ligne si vrai

Re...

(...) La macro fonctionne a partir de la Feuil1 (...)

Bonjour pierrejean,
Précision indispensable ! Il est vrai que la validité d'une procédure dépend essentiellement de l'endroit où elle implantée, et c'est probablement l'origine du problème de notre ami.
Merci pour votre attention scrupuleuse.​

Bonne journée.
ROGER2327
#2210

 

[nypon]

Re : Copie ligne si vrai

Re-Bonjour,

Merci Roger, merci Pierrejean

La procedure fonctionne bien dans mon classeur aussi après adaptation.

Cependant dès que j'ai plus de 55 lignes, il me met un message d'erreur:
Or je peux avoir plus de 5000 lignes.

erreur d'exécution '1004':
erreur définie par l'application ou par l'objet

est-ce que vous savez si c'est normal ?

Merci beaucoup,

 

[pierrejean]

Re : Copie ligne si vrai

Re

La limitation est probablement due au string selstr

je suggere l'essai de ceci

Sub selvrai1()
Application.ScreenUpdating = False
ligne = 1
tablo = Sheets("Feuil1").Range("A1:B" & Sheets("Feuil1").Range("A65536").End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
  If UCase(tablo(n, 2)) = "VRAI" Then
    Sheets("Feuil2").Cells(ligne, 1) = tablo(n, 1)
    Sheets("Feuil2").Cells(ligne, 2) = tablo(n, 2)
    ligne = ligne + 1
  End If
Next n
Application.ScreenUpdating = True
End Sub

 

[ROGER2327]

Re : Copie ligne si vrai

Re...

(...)
Cependant dès que j'ai plus de 55 lignes, il me met un message d'erreur:
Or je peux avoir plus de 5000 lignes.
(...)
est-ce que vous savez si c'est normal ?
(...)

C'est normal : selstr est une chaîne qui fait référence à un trop grand nombre de lignes.
Voici une version testée sur 5000 lignes :

[COLOR="DarkSlateGray"][B]Sub SelVrai()
Dim ligne As Range, r As Long
   Application.Calculation = xlCalculationManual
   For Each ligne In ActiveSheet.Range("A1:A" & Range("A65536").End(xlUp).Row).Rows
      If Cells(ligne.Row, 2).Text = "VRAI" Then
         If Cells(ligne.Row, 1) <> "" Then
            r = r + 1
            ActiveSheet.Rows(ligne.Row).Copy Destination:=Sheets("Feuil2").Rows(r)
         End If
      End If
   Next
   Application.Calculation = xlCalculationAutomatic
End Sub[/B][/COLOR]

Voyez si cela peut convenir.​

ROGER2327
#2214
_
__________________
Re-re bonjour, pierrejean. La précaution avec UCase n'est peut-être pas superflue. On n'est jamais assez prudent.

 

[nypon]

Re : Copie ligne si vrai

Re-Bonjour Messieurs,

La solution de Roger me convient, j'ai réussit à l'adapter sans problème, cependant, il faut être sur la feuille 1 pour que ça fonctionne. ce n'est pas trés génant pour ce que j'ai à faire pour l'instant.

PierreJean, je n'ai pas réussit à adapter votre code, il me met un message d'erreur ( erreur '9'). pourtant, il fonctionne avec l'exemple. il faut que je vois à adapter cela, mais plus tard.

Je vais essayer de faire mes traitements comme cela pour l'instant.

Je vous remercie, je vais essayer d'adapter le problème des feuilles.

Merci encore, à très bientôt,

cordialement,

 

[ROGER2327]

Re : Copie ligne si vrai

Re...

(...)
La solution de Roger me convient, j'ai réussit à l'adapter sans problème, cependant, il faut être sur la feuille 1 pour que ça fonctionne.
(...)

Celle-ci devrait être indépendante de la feuille d'appel :

[COLOR="DarkSlateGray"][B]Sub SelVrai()
Dim ligne As Range, r As Long
   Application.Calculation = xlCalculationManual
   With Sheets("Feuil1")
      For Each ligne In .Range("A1:A" & .Range("A65536").End(xlUp).Row).Rows
         If .Cells(ligne.Row, 2).Text = "VRAI" Then
            If .Cells(ligne.Row, 1) <> "" Then
               r = r + 1
               .Rows(ligne.Row).Copy Destination:=Sheets("Feuil2").Rows(r)
            End If
         End If
      Next
   End With
   Application.Calculation = xlCalculationAutomatic
End Sub[/B][/COLOR]

ROGER2327
#2216

 

[nypon]

Re : Copie ligne si vrai

Bonjour Roger,

Merci beaucoup, ça fonctionne sans problème.

Je vous remercie.

Merci aussi à PierreJean, grâce à vous deux je vais pouvoir avancer.

à bientôt,

cordialement,

 

[nypon]

Re : Copie ligne si vrai

Bonsoir Messieurs,

J'ai essayé de me positionner en bas de mon tableau, alors j'ai fait :
Afin de faire une moyenne pour chacune de mes colonne.

J'arrive à me positionner en bas du tableau en faisant sur la colonne que je veux avec le code suivant :

Range("A:A").End(xlDown).End(xlToLeft).Select
ActiveCell.Offset(0, 2).Select

ensuite, je souhaite sélectionner toutes les données de cette colonne depuis la dernière cellule mais je sélectionne toute la colonne avec :

ActiveCell.EntireColumn.Select

Le but des manips étant de faire une série de fonction sous chaque colonne,
Je souhaite faire une moyenne, un max et un min, un écart type...

J'arrive à me positionner sous le tableau et je sais a peu près faire les formules dans une cellule, mais je n'arrive pas à lui dire de prendre en compte une clonne depuis la dernière cellule jusqu'à la première sans l'entête (qui est du texte).

Ca n'a pas l'aire très compliqué mais franchement, je bloque.

Je vous remercie,

à très bientôt j'espère,

cordialement,

 

[nypon]

Re : Copie ligne si vrai

Bonjour,

J'ai un peu avancé me semble-t-il mais je n'ai pas encore la solution.

J'ai ajouté ce code afin de calculer la moyenne sur toutes les lignes qui ont été reportées.

pre = Sheets("Feuil1").Range("A:A").End(xlUp).End(xlToLeft).Offset(1, 2).Select
der = Sheets("Feuil1").Range("A:A").End(xlDown).End(xlToLeft).Offset(0, 2).Select

lig = Sheets("Feuil1").Range("A:A").End(xlDown).End(xlToLeft).Offset(2, 2).Select
ActiveCell.FormulaR1C1 = "= AVERAGE(" & pre & ":" & der & ")"

Avec "pre" je sélectionne la deuxième ligne de mon tableau, avec "der", je selectionne la dernière ligne.

ensuite, je me positionne deux lignes en dessous avec lig (mais je ne l'utilise pas). ensuite, quand je fais la moyenne, il n'y a pas de message d'erreur mais dans la case ou doit se trouver la moyenne, il y a écrit dans la barre des formules : = MOYENNE('Vrai':'Vrai') comme si pre et der renvoyaient vrai au lieu de renvoyer la première et la dernière cellule.

Est-ce que vous auriez un petit coup de pouce, je pense que je ne suis pas loin.

Je vous remercie d'avance,

cordialement,

 

[pierrejean]

Re : Copie ligne si vrai

Re

1) Oter les .select
2) pre et der donnent le contenu des cellules alors que la fonction AVERAGE attend des adresses de cellule
3) Il faudrait donc remplacer .select par .address
4) toutefois si le contenu est "Vrai" Average renverra une erreur

Est-il possible d'avoir un exemple proche du fichier final (quelque lignes suffisent sans données confidentielles) ?