エクセルで多数シートの表を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 · ベストアンサー

簡単に作る方法は思い浮かびませんがプログラムを作って、それにさせれば簡単です。ただ希望に沿ったプログラムに改造するには、ある程度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

お礼

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

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

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