【Excel マクロ】別シートの表に1行おきにデータを貼り付けしたい

全くの初心者です。
Excelで、以下のようにSheet1のＡ列(品名)の値を、Sheet2のＢ列(品名)に1行おきに貼り付けをマクロでおこないたいです。
ｺｰﾄﾞを教えてください。

例）

【Sheet1】　　　　　　　　　　　　　 【Sheet2】
　　A列　　　　　　　　　　　　　　　　　　B列
1　　品名　　　　　　　　　　　　　　　1　　品名 　
2　　りんご　　　　　　　　　　　　　　2
3　　バナナ　　　　　　　　　　　　　　3　
4　　キウイ　　　　　　　　　　　　　　4　　
5　　　・　　　　　　　→→→　　　　　5
6　　　・　　　　　　　　　　　　　　　6　　
7　　　・　　　　　　　　　　　　　　　7
　　　　・　　　　　　　　　　　　　 　8　　りんご
　　　　・　　　　　　　　　　　　　 　9
　　　　　　　　　　　　　　　　　　　10　　バナナ
　　　　　　　　　　　　　　　　　　　11
　　　　　　　　　　　　　　　　　　　12　　キウイ
　　　　　　　　　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　　　　　　　　　・
＜Ａ列の値をｺﾋﾟｰ＞　→　＜Ｂ列8行目から値を1行おきに貼り付け＞

実際のデータは、500件くらいあります。

No.1 ベストアンサー 回答者： GooUserラック 回答日時： 2016/11/09 15:49

こんなのはいかがですか？

--------------------------------------------------------
Sub Sample()
Dim 元 As Long
Dim 先 As Long
Sheets("Sheet1").Select
先 = 8
For 元 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet2").Cells(先, 2).Value = Cells(元, 1).Value
先 = 先 + 2
Next
Sheets("Sheet2").Select
End Sub
--------------------------------------------------------