エクセルで多数シートの表を1シートにまとめる方法

　エクセルで下記のような表があり、店舗別に１00店舗分のシートがあります。それを分類Ａ、Ｂ別に1枚のシートにしたいのですが、簡単に作る方法はあるでしょうか。

【店名ア シート】
分類Ａ　個数
商品１　60
商品２　40
商品３　20

分類Ｂ
商品４　50
商品５　80
商品６　30

　　　↓↓↓

【分類Ａシート】　　　　　　　　　【分類Ｂシート】
店名ア　商品１　60　　　　　　　店名ア　商品４　50
　 　 　　商品２　40　　　　　　　 　 　 　　商品５　80　
　 　 　　商品３　20　　　　　　　 　 　　　商品６　30
店名イ　商品１　30　　　　　　　店名イ　商品４　60　
　 　 　　商品２　10　　　　　　　 　 　　　商品５　40
　 　　　商品３　20　　　　　　　 　　 　　商品６　20

No.1 ベストアンサー 回答者： pc_knight 回答日時： 2007/05/12 21:09

簡単に作る方法は思い浮かびませんがプログラムを作って、それにさせれば簡単です。

ただ希望に沿ったプログラムに改造するには、ある程度VBAの勉強が必要かも。
プログラムを作る時、次の事項を明確にします。
・あるシートが店舗別シートなのか分類別シートなのかを判定する仕組み
（例）シート名に「店」という文字が含まれていたら店舗別シートとする。
・店舗別シート内のどのセルのデータが分類名を表しているのかを判定する仕組み
（例）分類名の前に「分類：」などを付加して「分類：○○」とインプットされたセルのデータを分類名とする。
この例を適用して作った下記プログラムをVBA標準モジュールに貼付け、マクロ実行を行うと実現できます。貼付方法は参考URLを。
Sub Test()
For Each cm In Sheets
If InStr(cm.Name, "店") = 0 Then
cm.Select
Cells.ClearContents
Range("A1").Value = "店舗名"
Range("B1").Value = "商品名"
Range("C1").Value = "数量"
End If
Next cm
For Each cm In Sheets
If InStr(cm.Name, "店") > 0 Then
cm.Select
rme = Range("A65536").End(xlUp).Row
bunsht = ""
For rm = 1 To rme
bunsht = "分類シート要追加"
If InStr(Cells(rm, 1), "分類：") > 0 Then
bnr = Right(Cells(rm, 1), Len(Cells(rm, 1)) - 3)
For Each cs In Sheets
If cs.Name = bnr Then
Sheets(bnr).Select
rsb = Range("B65536").End(xlUp).Row
Cells(rsb + 1, 1).Value = cm.Name
bunsht = "分類シート既存"
Exit For
End If
Next cs
If bunsht = "分類シート要追加" Then
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = bnr
Sheets(bnr).Range("A2").Value = cm.Name
Sheets(bnr).Range("A1").Value = "店舗名"
Sheets(bnr).Range("B1").Value = "商品名"
Sheets(bnr).Range("C1").Value = "数量"
End If
Else
Sheets(bnr).Select
rsb = Range("B65536").End(xlUp).Row
If cm.Cells(rm, 1) <> "" And cm.Cells(rm, 2) <> "" Then
Cells(rsb + 1, 2).Value = cm.Cells(rm, 1)
Cells(rsb + 1, 3).Value = cm.Cells(rm, 2)
End If
End If
cm.Select
Next rm
End If
Next cm
MsgBox "終了"
End Sub

参考URL：http://excelvba.pc-users.net/fol1/1_1.html

この回答へのお礼

回答どうもありがとうございました。
なかなか返信もらえないので、あきらめていました。

プログラミングは難しいので、勉強しながら理解してみます。
また書きます。

どうもありがとうございました。

お礼日時：2007/05/16 18:53