Sub CopierDates3Fois()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Feuil1") 'Remplacez "Feuil1" par le nom de votre feuille
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 1 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If Not dict.Exists(ws.Cells(i, "A").value) Then
dict.Add ws.Cells(i, "A").value, 1
End If
Next i
Dim j As Byte
Dim k As Long
k = 0
For i = 0 To dict.Count - 1
Dim key As Variant
key = dict.Keys()(i) '
For j = 1 To 3 'Boucle pour écrire la date trois fois dans la nouvelle colonne
k = k + 1
ws.Cells(k, "B").value = key
Next j
Next i
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row 'Trouve la dernière ligne remplie dans la nouvelle colonne
With ws.Sort 'Trie la nouvelle colonne
.SetRange ws.Range("B1:B" & lastRow)
.Header = xlNo 'Définit la première ligne comme une ligne de données à trier
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
End Sub
