Cell copy the data to another cell with offset

[dpatel]

Hi,

Hope some one can help me on my query. I would like to write a macro/formula which display a result as describe on the attachment. Is it possible to copy the data from one cell to other cell and insert a blank row (offset)?

Thanks for your help!

[Bob Phillips]

Sub FormatData()
Dim lastrow As Long
Dim i As Long

Application.ScreenUpdating = True

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 2 Step -1

.Rows(i + 1).Insert
.Cells(i, "G").Resize(, 3).Copy .Cells(i + 1, "D")
Next i
With .Range("B2:E2").Resize(lastrow * 2 - 1)

.HorizontalAlignment = xlRight
End With

.Rows(2).Insert

.Range("G1:H1").Copy .Range("D1")

.Columns("F:H").Delete
End With

Application.ScreenUpdating = False
End Sub

[dpatel]

Thanks, worked well!