Sub travdemande()
Dim i As Long
Dim dl1 As Long
Dim dl2 As Long
Dim cellule As Range
Dim nomfeuille1 As String
Dim col1 As String
Dim lidep1 As Long
Dim lidep2 As Long
Dim nomfeuille2 As String
Dim col2 As String
'**********************************
nomfeuille1 = "Données"
col1 = "a"
lidep1 = 2
dl1 = Sheets(nomfeuille1).Range(col1 & "65536").End(xlUp).Row + 2
nomfeuille2 = "Récapitulatif"
col2 = "a"
lidep2 = 2
'************************************
With Sheets(nomfeuille1)
For Each cellule In .Range(col1 & lidep1 & ":" & col1 & .Range(col1 & "65536").End(xlUp).Row)
If cellule.Value <> "" Then
dl2 = Sheets(nomfeuille2).Range(col2 & "65536").End(xlUp).Row + 1
For i = 0 To 3
Sheets(nomfeuille2).Range("a" & dl2).Offset(0, i) = cellule.Offset(0, i).Value
cellule.Offset(0, i).Value = ""
Next i
End If
Next cellule
End With
End Sub