エクセル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 回答日時： 2009/05/23 17:27

下記の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

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

この回答へのお礼

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

お礼日時：2009/05/24 11:32