エクセル2003で横に並んだデータを縦に並べたい

質問

エクセル2003で最終的には簡単なデータベースを作りたいのですが、
現在の形を変えないと希望しているデータが取れないそうです。データ量が多い為、
一括処理してくれるようなマクロもしくはVBAを希望しております。
下記に具体的なデータを記載しますので、どうかお知恵をお貸し下さい。
よろしくお願い致します。

○現在の形
A1: (名前)
A2: 太郎 B2: 12月90点 C2: 11月34点 D2: 10月54点
A3: 花子 B3: 12月39点
A4: 健介 B4: 12月100点 C4: 11月75点
A5: 二郎 B5: 12月45点 C5: 11月47点 D5: 10月33点 E5: 9月76点 ・・・
A6: 美佐子 B6: 12月22点

・・・・以下3000行ぐらいあります。またB列以降の列は最大でも30列ぐらいまであります。

↓希望している形
A1: (名前) B1: (点数一覧)
A2: 太郎 B2: 12月90点
A3: 太郎 B3: 11月34点
A4: 太郎 B4: 10月54点
A5: 花子 B5: 12月39点
A6: 健介 B6: 12月100点
A7: 健介 B7: 11月75点
A8: 二郎 B8: 12月45点
A9: 二郎 B9: 11月47点
A10: 二郎 B10: 10月33点
A11: 二郎 B11: 9月76点
A12: 美佐子 B12: 12月22点

・・・・と並べたいのです。

回答No.1

nag0720 · ベストアンサー

下記のVBAを参考にしてください。

Private Sub CommandButton1_Click()

　　Dim Row1 As Integer
　　Dim Col1 As Integer
　　Dim Row2 As Integer

　　Worksheets("Sheet2").Cells(1, 1) = "名前"
　　Worksheets("Sheet2").Cells(1, 2) = "点数一覧"

　　Row1 = 2
　　Row2 = 2
　　While Worksheets("Sheet1").Cells(Row1, 1) <> ""
　　　　Col1 = 2
　　　　While Worksheets("Sheet1").Cells(Row1, Col1) <> ""
　　　　　　Worksheets("Sheet2").Cells(Row2, 1) = Worksheets("Sheet1").Cells(Row1, 1)
　　　　　　Worksheets("Sheet2").Cells(Row2, 2) = Worksheets("Sheet1").Cells(Row1, Col1)
　　　　　　Col1 = Col1 + 1
　　　　　　Row2 = Row2 + 1
　　　　Wend
　　　　Row1 = Row1 + 1
　　Wend

End Sub

見やすくするために行頭に全角スペースを入れてます。コピーする場合は半角スペースに直してください。

お礼

ありがとうございます。
一発解決です!　感謝感謝