First let me iterate that your current layout is superior to the goal.
This will put all the dates together and the values together.
Option Explicit
Sub Reformat()
Dim delRNG As Range, LR As Long, Rw As Long, LastCOL As Long, c As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Set delRNG = Range("A" & LR + 1) 'seed the delrng for use
For Rw = LR To 3 Step -1
If Range("A" & Rw) = Range("A" & Rw - 1) Then
Range(Range("B" & Rw), Range("B" & Rw).End(xlToRight)).Copy Range("D" & Rw - 1)
Set delRNG = Union(delRNG, Range("A" & Rw))
End If
Next Rw
delRNG.EntireRow.Delete xlShiftUp
LastCOL = Cells.Find("*", Cells(Rows.Count, Columns.Count), _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
i = 3 'where to insert cut columns
For c = 4 To LastCOL Step 2
Columns(c).Cut
Columns(i).Insert
i = i + 1
Next c
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Bookmarks