Formellösning, antar att din originaltabell startar i A1 på blad1 (klistra in formeln på rad1 i något blad och kopiera ner):
=FÖRSKJUTNING(Blad1!$A$1;JÄMN(RAD())/2-1;ÄRJÄMN(RAD()))
Kod skulle kunna se ut så här, kolla hjälpen för Offset, SET samt "Do loop":
Sub Makro1()
Dim rKälla As Range
Dim rMål As Range
' Ange startpunkter
Set rKälla = Worksheets("Blad1").Range("A1")
Set rMål = Worksheets("Blad2").Range("A1")
Do Until rKälla.Value = ""
rMål.Value = rKälla.Value
rMål.Offset(1, 0).Value = rKälla.Offset(0, 1).Value
' flytta ner källan en rad och Målet 2 rader
Set rKälla = rKälla.Offset(1, 0)
Set rMål = rMål.Offset(2, 0)
Loop
End Sub