Copier des lignes et condition colonne

[sebbb]

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

 

[jeromegmc]

Salut,

Tu souhaites une réponse en VBA?
Joins nous un fichier, please.

A+

Message édité par: jeromegmc, à: 26/07/2005 11:09

 

[Sebbb]

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]

 

[michel_m]

Bonjour à tous

Ci joint proposition en formules d'après ton premier post

A+ [file name=sebbxld.zip size=7944]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/sebbxld.zip[/file]

 

[Sebbb]

Merci Michel,
Désolé d'avoir manqué de précision de mon premier post.

Je garde ton exemple sous le coude.

A +
Sébbb

 

[jeromegmc]

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.

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

 

[Sebbb]

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]

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é.

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

 

[Sebbb]

Merci,
Ca fonctionne impéccable!!!

A +

Sebbb