Sub Rassembler()
Dim plage As Variant, tablo()
Application.ScreenUpdating = False
Set plage = [A5].CurrentRegion.Offset(1)
[22:65536].Delete xlUp 'RAZ
plage.Copy [A22] 'où l'on veut, éventuellement dans une autre feuille...
Set plage = [A22].Resize(plage.Rows.Count, plage.Columns.Count)
plage.Columns(6).Insert xlToRight 'une colonne de plus
ReDim tablo(1 To plage.Rows.Count - 1, 1 To plage.Columns.Count)
plage = plage 'matrice, plus rapide
For i = 1 To UBound(tablo)
tablo(i, 1) = plage(i, 1)
tablo(i, 2) = plage(i, 2)
tablo(i, 3 - 2 * (plage(i, 4) = "Fin")) = plage(i, 3)
tablo(i, 4 - 2 * (plage(i, 4) = "Fin")) = Format(plage(i, 7), "hh:mm")
tablo(i, 7) = plage(i, 5)
If plage(i, 2) = plage(i + 1, 2) Then
tablo(i, 5) = plage(i + 1, 3)
tablo(i, 6) = Format(plage(i + 1, 7), "hh:mm")
i = i + 1
End If
Next
'---restitution---
With [A22].Resize(UBound(tablo), 7)
.Value = tablo
On Error Resume Next
.Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub