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