Copier des lignes et condition colonne

S

sebbb

Guest
Bonjour à toutes et à tous,

Je cherche mais n'arrive pas à résoudre mon problème...

Voilà, j'ai plusieurs lignes d'infos,
dans une des colonnes (D) j'ai des 1 et des 0,

Ce que je souhaiterai faire, c'est copier les lignes comprenant dans la colonne D un 1 sur une autre feuille.

C'est cette histoire de condition qui me bloque.
J'espère que quelqu'un aura la clé.

PS: Si ca peut apporter une précision, une fois le premier 1 écrit, l'alternance de 1 et 0 est impossible.

Merci à vous tous et à bientôt,
Sébbb
 

Sebbb

XLDnaute Nouveau
Salut Jérôme,

Voili voila le p'tit fichier,
je voudrais une réponse en VBa STP

A +

Sébbb [file name=Copier.zip size=4558]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Copier.zip[/file]
 

Pièces jointes

  • Copier.zip
    4.5 KB · Affichages: 28
  • Copier.zip
    4.5 KB · Affichages: 26
  • Copier.zip
    4.5 KB · Affichages: 26

jeromegmc

XLDnaute Occasionnel
Salut,

Voivi un code, dis moi si c'est ça.

Attention, hypothèse: une fois qu'on a rencontré un '1' il ne peut plus avoir de zéro.

Code:
Sub test()
Dim mylastrow, myfirstrow
Sheets('DONNEES').Select
Range('F3').Select
Selection.End(xlDown).Select
mylastrow = ActiveCell.Row
Range('F3').Select

Do Until ActiveCell.Row = myfirstrow
If ActiveCell.Value = 0 Then
ActiveCell.Offset(1, 0).Activate
Else: ActiveCell.Value = 1
myfirstrow = ActiveCell.Row
End If
Loop
Range(Cells(myfirstrow, 2), Cells(mylastrow, 6)).Select
Selection.Copy
Sheets('Les 1').Select
ActiveSheet.Range('A1').Select
ActiveSheet.Paste

End Sub



A+

Message édité par: jeromegmc, à: 26/07/2005 12:01
 
S

Sebbb

Guest
Merci à tous!

Jérôme,
Euh décidément j'ai encore mis les pieds dedans.

Ta macro fonctionne, seul soucis, j'ai plus de 0 après mes 1 mais les champs comporte une formule donc, le début de ton code ne conviens pas.
DESOLE pour le boulot,
Pourrais-tu arranger ca STP

Merci beaucoup,
A bientot
Sébbb
 

jeromegmc

XLDnaute Occasionnel
Resalut,


Voici le code modifié (si j'ai bien compris ce que tu voulais), intéressant ton pb, bien spécifique cependant, c'est pour cela que le programme n'est pas optimisé.

Code:
Sub test()
Dim mylastrow, myfirstrow
Sheets('DONNEES').Select
Range('F3').Select


'ici je trouve le n° de ligne du premier '1'
Do Until ActiveCell.Row = myfirstrow
If ActiveCell.Value = 0 Then 'si la valeur de cellule = 0 passer à la ligne suivante
ActiveCell.Offset(1, 0).Activate
Else: ActiveCell.Value = 1 'si la valeur de la cellule = 1
myfirstrow = ActiveCell.Row 'affecter le n° de ligne dans 'myfirstrow'
End If
Loop

'ici je trouve le n° de ligne du dernier '1'
Selection.End(xlDown).Select 'va à la dernière ligne du tableau
Do Until ActiveCell.Row = mylastrow
If ActiveCell.Value = 0 Then 'si la valeur de cellule = 0 passer à la ligne suivante
ActiveCell.Offset(-1, 0).Activate
Else: ActiveCell.Value = 1 'si la valeur de la cellule = 1
mylastrow = ActiveCell.Row 'affecter le n° de ligne dans 'mylastrow'
End If
Loop

'ici je copie/colle la zone du tableau qui ne possède que des '1'
Range(Cells(myfirstrow, 2), Cells(mylastrow, 6)).Select
Selection.Copy
Sheets('Les 1').Select
ActiveSheet.Range('A1').Select
ActiveSheet.Paste

End Sub


A+

Message édité par: jeromegmc, à: 26/07/2005 13:16
 

Statistiques des forums

Discussions
312 837
Messages
2 092 658
Membres
105 482
dernier inscrit
Eric.FKF