Sub macro1()
Dim iRow As Integer
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'change columns and initial iRow to suit
ws.Cells(1, 5) = ws.Cells(1, 1)
ws.Cells(1, 6) = ws.Cells(1, 2)
ws.Cells(1, 7) = ws.Cells(1, 3)
iRow = 2
Do Until ws.Cells(iRow, 1) = ""
ws.Cells(1 + iRow / 2, 5) = ws.Cells(iRow, 1)
ws.Cells(1 + iRow / 2, 6) = ws.Cells(iRow, 2) & "/" & ws.Cells(1 +
iRow, 2)
ws.Cells(1 + iRow / 2, 7) = ws.Cells(iRow, 3) & "/" & ws.Cells(1 +
iRow, 3)
iRow = iRow + 2
Loop
End Sub

Hth,
Merjet