bonjour kinarius en attendant de trouver mieux option explicit Sub test1()
Application.ScreenUpdating = False
For Each Cell In Range('a1', [a1].End(xlDown)).SpecialCells(xlCellTypeVisible)
If Cell.Value <> '' Then
Cell.Copy
Range('b65536').End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next
End Sub'salutations