エクセルのマクロについて 教えてください。

質問

エクセルのマクロについて　教えてください。

　　　　　１　　　　　　　　　　２　　　　　　…　
A　あ　い　う　え　　　お　□　□　□　　　　　　　※□はスペース
B　か　□　□　□　　　き　く　け　こ
C　さ　し　□　□　　　す　せ　そ　□　
：

上記、表を下のように並べ替えたいのですが…
※１行目は４つのセルの結合

１　A　あ　い　う　え
２　A　お　□　□　□
：
１　B　か　□　□　□
２　B　き　く　け　こ
：
１　C　さ　し　□　□
２　C　す　せ　そ　□
：

回答No.1

soixante · ベストアンサー

こんなのでどうですか。

Sub Narebikae()

Dim r As Long, c As Integer
Dim EndRow As Long, EndCol As Integer
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = ActiveSheet
Worksheets.Add After:=ActiveSheet
Set Ws2 = ActiveSheet

EndRow = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
EndCol = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For r = 2 To EndRow
　　　　For c = 2 To EndCol Step 4
　　　　　　Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Ws1.Cells(1, c).Value
　　　　　　Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Ws1.Cells(r, 1).Value
　　　　　　Range(Ws1.Cells(r, c), Ws1.Cells(r, c + 3)).Copy
　　　　　　Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
　　　　Next c
Next r
Cells(1, 1).Select

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

お礼

できました。
ありがとうございました。