Sub Copier()
Dim tablo, ncol%, n&, i&, j%
With Sheets("Virtuel")
.Cells.Delete 'RAZ
On Error Resume Next
Range([E1]).EntireColumn.Copy .[A1]
With .Columns(1).SpecialCells(xlCellTypeConstants, 1).Resize(, .UsedRange.Columns.Count)
.Sort .Columns(1), xlAscending, Header:=xlNo 'tri sur les dates/heures
tablo = .Value 'matrice, plus rapide
ncol = UBound(tablo, 2)
tablo(1, 1) = CDate(Format(tablo(1, 1), "dd/mm/yyyy hh:00")) 'arrondi à l'heure
n = 1
For i = 2 To UBound(tablo)
tablo(i, 1) = CDate(Format(tablo(i, 1), "dd/mm/yyyy hh:00")) 'arrondi à l'heure
If tablo(i, 1) = tablo(n, 1) Then
For j = 2 To ncol: tablo(n, j) = tablo(n, j) + tablo(i, j): Next j 'additionne les valeurs
Else
n = n + 1
For j = 1 To ncol: tablo(n, j) = tablo(i, j): Next j 'copie toute la ligne
End If
Next i
For i = 1 To n
tablo(i, 1) = Format(tablo(i, 1), "dd/mm/yyyy hh\h") & Format(Hour(tablo(i, 1)) + 1, " à 00\h")
Next i
.Resize(n) = tablo 'restitution
.Offset(n).Resize(.Rows.Count - n).Delete xlUp 'RAZ en dessous
End With
.UsedRange.Columns(1).AutoFit 'actualise les barres de défilement et ajuste la largeur de colonne
Application.Goto .[A1], True 'cadrage
End With
End Sub