リストで分けた項目を振り分けるマクロ

質問

おはようございます。

EXCELのマクロに関しましてご質問があります。
シート1のE5~E200まで1つのセルに各11項目あり、(ドロップダウンで選択するようになっています。)その項目毎に入力しています。
例えばA5のセルに2.1　E5のセルに電気代　F5のセルに　¥6,500
　　　A6のセルに2.5　E6のセルにガス代　F6のセルに　¥10,000
という感じです。

シート1のデータを他のシート(1月、2月とシートが有ります)に抽出したいです。
例えばシート1のE5の項目(11項目)を横に各項目(E1電気代　F1ガス代)に11項目並んでいて、
A2 2.1 　E2 ¥6,500 　他のセルは空白
A3 2.5 F3 ¥10,000 　他のセルは空白
このようなマクロはどのように記述すればいいでしょうか？
宜しくお願い致します。

回答No.1

noname#192382

sheet1にもとのdataがあり、sheet2に仕分けデータをいれるとします。sheet1のデータが仮に6行目まであるとしてmygyo1=　5　to　6のようにプログラムを作っていますが是を適宜直して使用してください。

' Macro1 Macro
' マクロ記録日 : 2012/4/10 ユーザー名 :
'
Dim mygyo1 As Integer, mygyo2 As Integer, mycolum As Integer, chkword As String

For mygyo1 = 5 To 6
mygyo2 = mygyo1 - 3

'MsgBox Worksheets(1).Cells(mygyo1, 5)
chkword = Worksheets(1).Cells(mygyo1, 5)
For mycolum = 5 To 11
If Worksheets(2).Cells(1, mycolum) = chkword Then
'MsgBox Worksheets(2).Cells(1, mycolum)
Worksheets(2).Cells(mygyo2, 1) = Worksheets(1).Cells(mygyo1, 1)
'MsgBox Worksheets(2).Cells(mygyo2, 1)
Worksheets(2).Cells(mygyo2, mycolum) = Worksheets(1).Cells(mygyo1, 6)
'MsgBox Worksheets(2).Cells(1, mycolum)
Else
End If