こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

ひと月分のシートを新ブックにまとめたい

当方、業務でExcel2003を使用しています。
タイトルに書いたように、一月分のエクセルのシートをマクロで新ブックを作成し、纏めたいと考えています。
残念ながら私はVBAについては最近知った程度ですのでほぼ判りません。
どなたか教えていただけるとありがたいです。

【PC】
OS→XP
Excel→2003

【やりたいこと】
添付画像の図3-1と図3-2のような結果が欲しいです。

具体的に申し上げますと、
日々、添付画像の図1のようなフォーマットで表に入力する業務があります。
1日分で5シートほどになり、月にすると70シートぐらいの量になります。

この一月分のシートは日毎にシート名が振られており、
例えば、6月6日であれば0606-1、0606-2、0606-3、0606-4、0606-5というふうになっています。

また、予め「まとめ」フォルダのConclusion.xlsというブックにまとめられています。

シートの順番も6月分であれば、
0601-1、0601-2、0601-3・・・・・・0631-3、0631-4、0631-5となっています。


VBAで図1の表(1)D5~M14(緑の背景色部分)を拾い上げ、
同「まとめ」フォルダ内に新ブック(例:6月分まとめ.xls)を作成し(図2-1)、
「自工場まとめ」シートにセルA1から昇順で羅列し、

おなじく図1の表(2)D17~M26(青の背景色部分)を拾い上げ、
同「まとめ」フォルダ内のブック名6月分まとめ.xlsに、
新シートを作成(シート名:他工場まとめ 図2-2)、セルA1から昇順で羅列。

なお、図3-1と3-2には1行目に商品名、商品コード・・・・とありますが、
なくても構いません。

このようなマクロですが、出来る方いらっしゃいますでしょうか。
よろしくお願い致します。

投稿日時 - 2013-06-15 13:57:30

QNo.8134999

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

出来ますけど。

#1さんがおっしゃる「説明不足」に少々加えさせてください。




それを「ゼロから作りあげてくれ」ってことですか?




以上について説明が足りません。補足下さい。

投稿日時 - 2013-06-15 15:32:31

補足

daredakisama様
回答ありがとうございました。
説明が足りず申し訳ございませんでした。

ご回答いただいたように作り上げていただければ万々歳でした。
しかし、keithin様からヒントを頂けたので少し自分でもやってみようと思います。
お時間を割いて頂きましてありがとうございました。

投稿日時 - 2013-06-15 21:38:42

ANo.1

【説明不足の指摘】
Conclusion.xlsには当月1日の1枚目から当月末日の最後のシートまでのシート「以外のシートは全く一枚も含まれていない」とします
青の表と緑の表の具体的なセルの記入内容(「データの意味」じゃありませんので間違えない事)が不明なので、実際には「コピーする必要が無い行」もあると思われますが、判断する材料が無いので「青と緑のすべての行をコピーする」ことにします。この点はあなたの実際のエクセルに即した方法で、次のステップとしてご自分で改良してください。
どのようにマクロを運用したいのか不明のため、conclusion.xlsにマクロを持たせて実行する事にします
「昇順に並べる」の意味が不明のため、単純に日付とシートの古い方から上から順に並べていくだけにします
またご質問で掲示された画像に何か補足を書かれているようですが、読めませんのですべてスルーします



【具体的な手順】
conclusion.xlsを開く
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する

sub macro1()
 dim w as workbook
 dim i as long

’移動先の作成
 set w = workbooks.add
 w.worksheets(1).name = "自工場まとめ"
 w.worksheets(2).name = "他工場まとめ"

’転記
 for i = 1 to thisworkbook.worksheets.count
  w.worksheets(1).cells(i * 10 - 9, "A").resize(10, 10).value = thisworkbook.worksheets(i).range("D5:M14").value
  w.worksheets(2).cells(i * 10 - 9, "A").resize(10, 10).value = thisworkbook.worksheets(i).range("D17:M26").value
 next i

’名前を付けて保存
 w.saveas filename:=thisworkbook.path & "\" & val(left(thisworkbook.worksheets(1).name, 2)) & "月分まとめ.xls"
end sub

投稿日時 - 2013-06-15 15:27:55

補足

keithin様
回答ありがとうございます。
また、お時間を割いてマクロを教えていただき、重ねてお礼申し上げます。

説明不足の件および画像の件、申し訳ありませんでした。

keithin様の指示通り、回答いただいたマクロを元に自身で勉強し手を加えていこうとおもいます。

投稿日時 - 2013-06-16 16:40:13

あなたにオススメの質問