Не совсем понял - Вам на второй лист перенести нужно или на первом оставить?
Сделал 2 варианта
Это на второй лист
[vba]Код
Sub tt()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = ThisWorkbook.Sheets("Вставка")
Set sh2 = ThisWorkbook.Sheets("Итог")
With sh1
r1_ = .Range("A" & Rows.Count).End(3).Row
ar1 = Range("A1").Resize(r1_, 2)
ar2 = Range("A1").Resize(r1_ * 2)
For i = 1 To r1_
For j = 1 To 2
ar2((2 * i - 1) + j - 1, 1) = ar1(i, j)
Next j
Next i
End With
With sh2
.Columns(1).ClearContents
.Range("A1").Resize(r1_ * 2) = ar2
.Select
End With
End Sub
[/vba]