Como copiar celdas contiguas y poder ordenarlas

Tengo una base de datos como la que sigue:

Con la siguiente macro he conseguido que me seleccione los datos que esten en negrita y los ponga en una lista en la columna D

Sub SELECCIONAR()

fila = 1

Range("A500").End(xlUp).Offset(1, 0).Value = ""

Range("A1").Select

Do While ActiveCell.Value <> ""

If ActiveCell.Font.Bold Then

Cells(fila, 4).Value = ActiveCell.Value

fila = fila + 1

End If

ActiveCell.Offset(1, 0).Select

Loop

ActiveCell.ClearContents

End Sub

Pero no sé cómo hacer que el dato seleccionado se lleve asociada la celda con su fecha y pueda yo ordenar los datos por su fecha, desde la fecha más cercana a la más lejana de modo que quedase así:

Si pudiera ayudarme se lo agradecería mucho.