Sub Test()
Dim i&, C As Range
With Sheets("Feuil1")
For i = 5 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 16) > 0 Then
If C Is Nothing Then
Set C = Union(.Range(.Cells(i, 1), .Cells(i, 3)), .Cells(i, 9), _
.Range(.Cells(i, 11), .Cells(i, 17)))
Else
Set C = Union(C, .Range(.Cells(i, 1), .Cells(i, 3)), .Cells(i, 9), _
.Range(.Cells(i, 11), .Cells(i, 17)))
End If
End If
Next i
End With
C.Copy Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End Sub