Private Sub CommandButton1_Click()
Dim cellule As Range
With Sheets("Rapport Quotidien")
.Range("A4:B" & .[A65536].End(xlUp).Row).ClearContents
For Each cellule In Range("J28:J" & [J65536].End(xlUp).Row)
If cellule.Value <> "" Then
derlig = .[A65536].End(xlUp).Row + 1
.Cells(derlig, 1) = cellule.Offset(0, 6)
.Cells(derlig, 2) = cellule
End If
Next
End With
End Sub