マクロの組み方

質問

東京12.xlsとういデータに、12月の在庫1日～31日までがシート別にあります。このような形です→SheetZAIKO01～SheetZAIKO31
これを（東京12月まとめ.xls）として別エクセルにまとめたいのですが。

１2月のZAIKO01～ZAIKO31は、１行目がヘッダーで、
Ａ１店舗名　Ｂ１商品名　Ｃ１前月残　Ｄ１今月算
とあるので、
ZAIKO01は"A1:D?"までとりたいのですが、
残りのZAIKO02からはヘッダーが必要ないので、Ａ２から範囲指定をします。

"東京12月まとめ.xls"にまとめる際、
１２月のどの日付かがわかるように、Ａ行を日付の欄として設定をし、
たとえばZAIKO01であれば、Ａ行に１、ZAIKO02であれば2と
入れていくような設定にしたいです。

在庫状況は日々変動していますので、日によって、行数が異なっています。

今まで、恥ずかしながら手作業でまとめていたのですが、
毎月かならず発生する作業で東京以外のエリアもあり、時間的なロスがあまりにも大きいので、
大変お手数なのですが、よろしくお願いいたします。

回答No.2

merlionXX

とりあえず参考程度に一例を

Sub test01()
Dim ns As Worksheet, st As Worksheet
Dim a As Long, b As Long, c As Long
Dim d As Variant
Set ns = Sheets.Add(Before:=Sheets(1)) '先頭にシートを挿入
ns.Name = "まとめ" '名前を「まとめ」に
For Each st In Worksheets '各シートにつき
If st.Name Like "*ZAIKO*" Then 'ZAIKOが名前にあれば
With st 'そのシートの２行目以降の連続データをコピー
.Range(.Range(.Range("A2"), .Range("A2").End(xlDown)), .Range(.Range("A2"), .Range("A2").End(xlDown)).End(xlToRight)).Copy
End With
With ns
a = .Cells(Rows.Count, "B").End(xlUp).Offset(1).Row 'まとめシートのデータ挿入先行検索
.Cells(a, "B").PasteSpecial、B列から貼り付け
b = .Cells(Rows.Count, "B").End(xlUp).Row
.Range(.Cells(a, "A"), .Cells(b, "A")).Value = Right(st.Name, 2) 'A列に日付挿入
If .Cells(1, "B") = "" Then '1行目があいてれば
.Range("A1") = "日付" '見出しに「日付」
.Range("B1:F1").Value = st.Range("A1:E1").Value 'その他見出し
End If
End With
End If
Next
d = Application.GetSaveAsFilename(InitialFilename:=Left(ThisWorkbook.Name, 4) & "まとめ.xls", _
fileFilter:="XLSファイル (*.xls), *.xls")
'保存先確認＆ファイル名を現在のファイル名の左から4文字＋まとめ　とする。
If d = False Then 'キャンセルなら
MsgBox "ファイル作成をキャンセルしました。"
Exit Sub
Else
Sheets("まとめ").Copy
ActiveWorkbook.SaveAs Filename:=d 'まとめシートを保存
End If
End Sub