Sub Couper_coller()
Dim TabDepart, Tab1(), Tab2(), i As Long, x As Long, y As Long
With Worksheets("Feuil1")
TabDepart = .Range("A2:F" & .Range("B" & .Rows.Count).End(xlUp).Row)
For i = LBound(TabDepart) To UBound(TabDepart)
If TabDepart(i, 1) = "" Then
x = x + 1
ReDim Preserve Tab2(1 To 6, 1 To x)
For j = 2 To 6
Tab2(j, x) = TabDepart(i, j)
Next
Else
y = y + 1
ReDim Preserve Tab1(1 To 6, 1 To y)
For j = 1 To 6
Tab1(j, y) = TabDepart(i, j)
Next
End If
Next
.Range("A2:F" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents
.Range("A2").Resize(UBound(Tab1, 2), 6) = Application.Transpose(Tab1)
If x > 0 Then '
With Worksheets("Feuil2")
.Range("A2").Resize(UBound(Tab2, 2), 6) = Application.Transpose(Tab2)
.Range("D2:F" & UBound(Tab2, 2) + 1).NumberFormat = "hh:mm"
End With
End If
End With
End Sub