指定した数だけデータをコピペする方法

質問

VBAの参考例を教えてください。
＜シート１＞
A列に1から順に数字が入力されており、B列からE列まで数値のデータが入力されています。F列にはB列からE列にデータが入力されているセルの数をカウントした関数が入力されています。

＜シート２＞
シート１のB～Eに入力されたデータが縦に入れ替えの上A列にコピぺされています。

ここで、シート１のA列の数値をコピーし、シート１F列に示されたデータ数分だけ、シート２のF列に縦に順々にペーストしていく方法をご教示ください。シート１のA列に入力された数値が最後の行にくるまでこれを繰り返します。

シート１
A　B　C　D　E　F
1 　a　b　c　d　4
2　 e　d　f　　　3
3 　d　e　　　　 2
・
・
・

シート２
A　B　C　D　E　F
a　　　　　　　　　1
b　　　　　　　　　1
c　　　　　　　　　1
d　　　　　　　　　1
e　　　　　　　　　2
d　　　　　　　　　2
f　　　　　　　　　 2
d　　　　　　　　　3
e　　　　　　　　　3

当方、VBAは全くの初心者です。急遽仕事で必要になってしまい、質問しました。
どうぞよろしくお願いします。

回答No.2

mt2008

Sheet2のF列だけの処理でいいの？

Sub Sample()
　　Dim nRow As Long
　　Dim nCount As Long
　　Dim i
　　nRow = 1
　　With Worksheets("Sheet1")
　　　　For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
　　　　　　nCount = .Cells(i, 6).Value
　　　　　　Sheets("Sheet2").Range(Cells(nRow, 6), Cells(nRow + nCount, 6)) = .Cells(i, 1).Value
　　　　　　nRow = nRow + nCount
　　　　Next i
　　End With
End Sub

回答No.1

imogasi

誰も回答しないのは、質問の表現がややこしいからではないか。
＞B列からE列まで数値のデータが入力
例では文字列になっているのでは。混乱のもと。
＞指定した数だけデータをコピペする方法
標題として、実際にプログラム処理で必要なことを反映してない。
やりたいことを説明しとくとか。「表の組み換え」の問題だ。
ーー
シート２は出来てほしい結果だよね
B列からE列のの範囲で、セルを１つづと調べシート２のA列セルに転記
その際シート１での行番号（または行番号ー１かA列数字）をシート２のF列に入れる。
シート１で空白セルに出あわせば、スキップ。
こういうロジックを考える訓練をしないと。
たまたま、これに適当なFoe Each　Nextのくり返しがあることも、日頃勉強してナイト思いつかないだろうが。
標準モジュールに
Sub test02()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
rm = 1: k = 2
For Each cl In sh1.Range("B2:E" & d)
If cl <> "" Then
sh2.Cells(k, "A") = cl
sh2.Cells(k, "F") = cl.Row-1
k = k + 1
m = cl.Row
End If
Next
End Sub
cl.Row-1のところは字再の情況にあわせて。
結果
Sheet2
A列　　　　　　　　　　　　　　　　　　　　　　　　F列１2 1
18 1
23 1
56 1
22 2
6 2
5 2
25 3
2 3