エクセルの表を別のシートに縦に数行おきに書き移したい

質問

エクセルのSheet１　
A商品名　B種別　C金額　D 説明　・・・・
とまとめてあるデータを、別のシートの表に縦に数行おきに転記したいのです。たとえば
sheet2の
D3は空欄
D4にsheet1のA2
D5にsheet1のB2
D6にsheet1のC2
D7にsheet1のD2
D8にsheet1のE2
D9は空欄
そして、7行おきに違う商品のデータになり、繰り返します。
（A3～D9までを太いカラー罫線で囲んだフォーマットが商品個数分、空欄で既にsheet2に書き込まれています）
関数で効率よく、データを書き写すことが出来ますでしょうか？
よろしくお願いいたします。

回答No.2

noname#204879 · ベストアンサー

[No.1回答]の式を次式（ずっと短い）に置き換えてください。
=IF(MOD(ROW(1:1),7)<2,"",INDIRECT("Sheet1!"&CHAR(MOD(ROW(1:1),7)+63)&(INT((ROW(1:1)-1)/7)+2)))

お礼

お礼が大変遅くなり申し訳ありませんでした。
元の表の条件がその後変わり、教えて頂いた式がぴったり当てはまらず、マクロは難解すぎて自分では応用できず、停滞していました。
部分的には成功しました。感激でした。
ありがとうございました。

回答No.4

NCU

「商品個数分」なら商品ごとにTranspose関数でタテヨコ変換すればよろしいかと。
商品ごとに一個の配列になります。
あらかじめD4:D8を選択し、「=TRANSPOSE(Sheet1!A2:E2)」というような式を入力し、Shift+Ctrl+Enterで確定。
結果、「{=TRANSPOSE(Sheet1!A2:E2)}」のようにカッコが勝手に付きます。配列だからです。

お礼

お礼が大変遅くなり申し訳ありませんでした。
マクロは難解すぎて自分では応用が利かず、停滞していました。
教えて頂いたものは、今後も自分でこなせそうです。
ありがとうございました。

回答No.3

ape5

少しまだ飲み込めてないところがあるので、以下のような前提で作りました。
1.コピー元のデータは１データが５列分で１行に１レコードのみが存在する。
2.コピー先のフォーマットはD列に全部レコードが縦にあり、レコード同士はセル２個分の空白で区切られている

------------------------------------
Sub myCopy()
Const OFFSET As Integer = 3
Dim a As Range
Dim iRow As Long
Dim iCount As Integer 'Sheet2の行の値を保持

iCount = 1
iRow = 1

For Each a In Selection
Worksheets(2).Cells(OFFSET + iRow, 4).Value = a.Value
iRow = iRow + 1
iCount = iCount + 1

If iCount Mod 6 = 0 Then 'データの折り返しかチェック
iCount = 1
iRow = iRow + 2
End If

Next a

End Sub
-----------------------------
おかしいところがあるときや、前提が違う時などはコメントつけてくれれば見直します。

お礼

ご丁寧な式をありがとうございました。
難解すぎて、試せませんでした。
コメントまでつけて下さったのにすみません。

回答No.1

noname#204879

Sheet2 のセル D3 に次式を入力して、そのフィルハンドルを右クリックして下方にドラッグして[書式なしコピー(フィル)]を選択
=IF(ISERROR(INDIRECT("Sheet1!"&CHAR(MOD(ROW(1:1),7)+63)&(INT((ROW(1:1)-1)/7)+2))),"",INDIRECT("Sheet1!"&CHAR(MOD(ROW(1:1),7)+63)&(INT((ROW(1:1)-1)/7)+2)))