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,

 

[nypon]

Re : Copie ligne si vrai

Bonjour PierreJean,

Oui bien sure, voici un fichier ici

Voici le code :

Sub selvrai()

Sheets(1).Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-10]>=5,RC[-10]<=8.5,AND(RC[-9]>=41.5,RC[-9]<=43.5)),TRUE,"""")"
    Range("K2").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

Ceci sélectionne la colonne K de la feuille 1 et renvoie vrai si la colonne A et B répondent aux critères.

Dim ligne As Range, r As Long
   Application.Calculation = xlCalculationManual
   With Sheets(1)
      For Each ligne In .Range("A1:A" & .Range("A65536").End(xlUp).Row).Rows
         If .Cells(ligne.Row, 11).Text = "VRAI" Then
            If .Cells(ligne.Row, 1) <> "" Then
               r = r + 1
               .Rows(ligne.Row).Copy Destination:=Sheets(2).Rows(r)
            End If
         End If
      Next
   End With
   Application.Calculation = xlCalculationAutomatic

Ce second morceau, sélectionne les lignes "VRAI" et les collent dans la feuille 2

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

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

Enfin, je souhaitais faire une moyenne et les autres stats (ecart type, min, max... comme dans la feuille 1 du document)sur chaque colonne, mais c'est la que ça bloque.

Lorsque je met .Address à la place de select, ça ne fonctionne pas il y a une erreur '1004'.
De plus, j'avais testé la moyenne dans un autre module et maintenant depuis que je l'ai ajouté au code précédent, je suis encore obligé de le lancé depuis la feuille 1.

Voilà, j'espère que ce n'est pas trop confus.

Merci de votre aide.

Cordialement,

 

[nypon]

Re : Copie ligne si vrai

Bonjour, j'ai trouvé une solution pour calculer la moyenne :

Sheets(2).Range("C2:C" & Range("A65536").End(xlUp).Row).Select
Set plage = Selection.CurrentRegion
ActiveWorkbook.Names.Add Name:="plage", RefersTo:=Selection 'Je ne sais pas à quoi sert cette ligne

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

ActiveCell.FormulaR1C1 = "=average(plage)"

Mais quand j'essaye de compiler le tout, ce n'est pas bon,
Voici mon code final. Je suis obligé de le lancer depuis la feuille 1.

Sub selvrai()

Sheets(1).Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-10]>=5,RC[-10]<=8.5,AND(RC[-9]>=41.5,RC[-9]<=43.5)),TRUE,"""")"
    Range("K2").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
Dim ligne As Range, r As Long
   Application.Calculation = xlCalculationManual
   With Sheets(1)
      For Each ligne In .Range("A1:A" & .Range("A65536").End(xlUp).Row).Rows
         If .Cells(ligne.Row, 11).Text = "VRAI" Then
            If .Cells(ligne.Row, 1) <> "" Then
               r = r + 1
               .Rows(ligne.Row).Copy Destination:=Sheets(2).Rows(r)
            End If
         End If
      Next
   End With
   Application.Calculation = xlCalculationAutomatic
   
Sheets(2).Range("C2:C" & Range("A65536").End(xlUp).Row).Select
Set plage = Selection.CurrentRegion
ActiveWorkbook.Names.Add Name:="plage", RefersTo:=Selection

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

ActiveCell.FormulaR1C1 = "=average(plage)"
End Sub

Il y a toujours une erreur qui empêche de réaliser tout le code alors qu'individuellement, les morceaux fonctionnent bien

Avez-vous une idée ?

 

[nypon]

Re : Copie ligne si vrai

J'ai un peu avancé encore, et j'ai un code qui fonctionne
Mais j'ai encore des problèmes pour l'automatisation

Voici le code qui permet de faire la moyenne sur la colonne C :

Sub selvrai()

Sheets(1).Select
Sheets(1).Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-10]>=5,RC[-10]<=8.5,AND(RC[-9]>=41.5,RC[-9]<=43.5)),TRUE,"""")"
    Range("K2").Select
    Selection.Copy
    'Range(Selection, Selection.End(xlDown)).Select
    Range("K2:K" & Range("A65536").End(xlUp).Row).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
Dim ligne As Range, r As Long
   Application.Calculation = xlCalculationManual
   With Sheets(1)
      For Each ligne In .Range("A1:A" & .Range("A65536").End(xlUp).Row).Rows
         If .Cells(ligne.Row, 11).Text = "VRAI" Then
            If .Cells(ligne.Row, 1) <> "" Then
               r = r + 1
               .Rows(ligne.Row).Copy Destination:=Sheets(2).Rows(r)
            End If
         End If
      Next
   End With
   Application.Calculation = xlCalculationAutomatic
   
Sheets(2).Select
Sheets(2).Range("C2:C" & Range("A65536").End(xlUp).Row).Select
Set plage = Selection.CurrentRegion
ActiveWorkbook.Names.Add Name:="plage", RefersTo:=Selection

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

ActiveCell.FormulaR1C1 = "=average(plage)"

End Sub

Le truc c'est qu'il écrit =Moyenne(Plage) dans la barre des formules...
J'ai essayé de copier la cellule et de coller sur toute la ligne, mais il me prends toujours la même plage de référence.
Bon en trichant, j'arrive à remplir la seconde cellule pour la moyenne de la seconde colonne en ajoutant le bout de code ci dessous à la suite.

Sheets(2).Range("D2:D" & Range("A65536").End(xlUp).Row).Select
Set plage2 = Selection.CurrentRegion
ActiveWorkbook.Names.Add Name:="plage2", RefersTo:=Selection

Sheets(2).Range("A:A").End(xlDown).End(xlToLeft).Offset(2, 3).Select

ActiveCell.FormulaR1C1 = "=average(plage2)"

Mais il me semble que ce n'est pas le but de réécrire ce bout de code autant de fois que j'ai de colonne. en plus c'est laid non?
Ce que je voudrais faire c'est copier la formule, en tirant vers la droite comme à la main :

'Selection.AutoFill Destination:=Range("C3124:J3124"), Type:=xlFillDefault

Cependant, je ne sais pas combien de lignes j'aurais à chaque fois (3000 ou 800... c'est toujours différent).

Je me dis qu'une boucle pourrait être réalisée pour répeter le bout de code qui sert à faire la moyenne pour chaque colonne, mais je n'y arrive pas.

Est-ce que quelqu'un pourrait me donner un coup de main ... après le pouce

Merci d'avance,

cordialement,