Re,
Essaye avec ce code :
Sub copie()
Dim derlig1 As Integer, derlig2 As Integer, i as integer
derlig1 = Range("F65536").End(xlUp).Row
For i = 2 To derlig1
If Cells(i, 6) <> "" And Cells(i, 6).Interior.ColorIndex = xlNone Then
derlig2 = Sheets("Feuil2").Range("A65536").End(xlUp).Row
With Range(Cells(i, 3), Cells(i, 40))
.Copy Sheets("Feuil2").Range("A" & derlig2 + 1)
.Delete shift:=xlUp
End With
i = i - 1
End If
Next i
End Sub