ExcelVBA:行列入れ替えと文字の複数コピー

質問

VBA初心者です。お教え下さい。
下記の元データを

【元データ】
NO A-NO S1 S2 S3 S4 S5
AAA1 A1　 1 2 3 4 5
AAA1 A2 11 12 13 14 15
BBB2 A3 21 22 23 24 25
BBB2 A4 31 32 33 34 35

それを、下記のようにしたいんです。
NO A-NO
AAA1 A1 S1 1
AAA1 A1 S2 2
AAA1 A1 S3 3
AAA1 A1 S4 4
AAA1 A1 S5 5
AAA1 A2 S1 11
AAA1 A2 S2 12
AAA1 A2 S3 13
AAA1 A2 S4 14
AAA1 A2 S5 15
BBB2 A3 S1 21
BBB2 A3 S2 22
BBB2 A3 S3 23
BBB2 A3 S4 24
BBB2 A3 S5 25
BBB2 A4 S1 31
BBB2 A4 S2 32
BBB2 A4 S3 33
BBB2 A4 S4 34
BBB2 A4 S5 35

検索などして、行列の入れ替えを試していたのですが、うまくいきません。
お知恵を拝借させて下さい。

Sub macro()
Dim LastRow, Trow, i As Long
LastRow = Range("A65536").End(xlUp).Row + 4
For i = 1 To Int(LastRow / 5
Trow = i * 5 - 4
Cells(Trow, 12) = Cells(Trow, 1)
Cells(Trow + 1, 12) = Cells(Trow, 2)
Cells(Trow + 2, 12) = Cells(Trow, 3)
Cells(Trow + 3, 12) = Cells(Trow, 4)
Cells(Trow + 4, 12) = Cells(Trow, 5)

Next
Range(Cells(1, 1), Cells(LastRow, 5)).Clear
End Sub

回答No.1

hotosys · ベストアンサー

行列の入れ替えは「形式を指定して貼り付け」の「行列を入れ替える」を使うと短くて楽かも。
色々やり方はあるだろうけど、Sheet1からSheet2に作る場合。
Sub sample()
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim srcRow As Long
Dim dstRow As Long
Set srcSheet = Sheets("Sheet1")
Set dstSheet = Sheets("Sheet2")
'クリア
dstSheet.Cells.Clear
'見出しコピー
srcSheet.Range("A1:B1").Copy Destination:=dstSheet.Range("A1:B1")
dstRow = 2
For srcRow = 2 To srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row
'NOとA-NOを行方向5行にコピー
srcSheet.Cells(srcRow, "A").Resize(1, 2).Copy Destination:=dstSheet.Cells(dstRow, "A").Resize(5, 2)
'[S1 S2 S3 S4 S5]見出しコピー
srcSheet.Range("C1:G1").Copy
'行列を入れ替えて貼り付け
dstSheet.Cells(dstRow, "C").PasteSpecial Transpose:=True
'[S1 S2 S3 S4 S5]データコピー
srcSheet.Cells(srcRow, "C").Resize(1, 5).Copy
'行列を入れ替えて貼り付け
dstSheet.Cells(dstRow, "D").PasteSpecial Transpose:=True
'コピー先+5
dstRow = dstRow + 5
Next
Application.CutCopyMode = False
End Sub

お礼

早速回答ありがとうございます！
うまくいきました！感動です！
本当、ありがとうございました！

回答No.2

hallo-2007

【元データ】
NO A-NO S1 S2 S3 S4 S5
AAA1 A1　 1 2 3 4 5
AAA1 A2 11 12 13 14 15
BBB2 A3 21 22 23 24 25
BBB2 A4 31 32 33 34 35
は　S1～S5まで固定ですか
別シート
A列に　=INDEX(元データ!A:A,INT(ROW(A5)/5)+1)　B列にコピイ　下までコピイ
C列に　=INDEX(元データ!C:G,INT(ROW(C5)/5)+1,MOD(ROW(C5),5)+1)
下までコピイでは　ダメでしょうか。

お礼

早速の回答ありがとうございます！
Ｓ１～Ｓ５は固定なんです。
そして、回答頂いた内容で、思い通りの結果が得られました！
本当にありがとうございました！