Ｅｘｃｅｌの複数ファイルの内容を新しいファイルに集計する方法について教えてください

ExcelのマクロやVBA等の本を見たりして勉強してますが全く付いていけず困っております。
お力お貸しください。。。

複数店舗の売上や予約数等（項目別に別Seetになってます）を今はリンク貼り付けでどうにか対応していますが、今後店舗が増えていくと作業が追い付かなくなってしまいます。
ファイル名は（＊＊＊＊2706管理表）で統一されており、月が替われば2706⇒2707等に変更するようになっています。
各店舗のシート名（予約と媒体）の必要箇所（C、E、F、G列の３～３３）だけを集計用の別ファイルに取り込みを毎日行いたいのです。更に、取り込む列は縦ですが別ファイルに取り込んだ時には
その列を横向きに表示をさせたいです。
ネットで調べたりしてみましたが理解が出来ず質問させて頂きました。
皆さん何卒ご教授お願いします

質問者からの補足コメント

• hallo-2007にご教授頂いたコードを書いて実行してみましたがsubまたはfunctionが定義されていません。とエラーが出てしまい１日中解決策を模索してましたが全く答えを導き出せませんでした。。。
  私の実行させようとしているマクロは複雑なものなのでしょうか・・・・？
  本を２冊購入して勉強してますが、実行しようとするマクロの説明などが１つも無く折角教えて頂いているんですが、何がどうなっているのかも不明に・・・。
  初心者すぎて本当に恥ずかしいですが、教えてください。

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/05/24 14:30

No.1 ベストアンサー 回答者： hallo-2007 回答日時： 2015/05/23 17:35

この場合の他のブックを開くには

Dir関数を使う事になります。
ネットで一度、調べてみてください。

仮に、取り込むブックの　
A１セル　に、データがあるフォルダへのパスを記述
A2セル　に、2706管理表.xlsx
と入れておいてください。

Sub Sample1()
Dim buf As String
buf = Dir(Range("A1").Value & "\*" & Range("A2").Value)
'変数に指定したフォルダにある2706管理表.xlsxで終わるファイル名を入れる

Do While buf <> ""
GYOU=Range("A" & Rows.Count).End(Xlup).Row+1
'このブックのデータが入っている最終行番号を取得しておく
Workbooks.Open Range("A1").Value & "\" & buf
'最初のファイルを開く
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU+30).Value=ActiveBook.Sheet("予約と媒体").Rnage("C3:G33").Value
'このシートの最終行の下に、指定したシート名のC3～G33の値を入れる
Workbooks(buf).Close SaveChanges:=False
開いたブックを閉じる
buf = Dir()
'次のブックへ
Loop
End Sub

こんな感じになると思います。
動作は確認していません。エラーが出たらご自身で修正してみてください。
補足に気が付けば、再度、回答いたします。

この回答へのお礼

早速回答して頂きありがとうございます。
コードを使用させて頂き、実際にマクロを動かしてみます。
その時にまた問題にぶつかってどうしようもない場合はご教授お願いします。

お礼日時：2015/05/23 22:01

No.10 回答者： hallo-2007 回答日時： 2015/05/26 19:50

A2セルですが

＞A2セルに*2706管理表.xls　を含む*を入力しました。
*2706管理表.xls*
だけですよね。
2706管理表.xlsの前後に＊（アスタリスク）を付けるだけ。

この回答へのお礼

ありがとうございます！マクロ稼働しました！！
後は自分なりにもっと勉強してみます。
本当に何から何までありがとうございます！！

お礼日時：2015/05/26 22:44

No.9 回答者： hallo-2007 回答日時： 2015/05/25 21:30

保存した2706管理表.xlsのファイルを右クリックして

プロパティで確認します。
全般のタブで場所に表示されています。
そのまま、コピーして貼り付けても大丈夫です。

A1セルには
C:\Users\私の名前\Desktop\管理表集計テスト

A2セルには
*2706管理表.xls*
と前後に＊を追加で、2706管理表.xls　を含む
で一度試してみてください。

この回答へのお礼

A1セルに上記教えて頂いたパスを確認してコピー貼り付け行い、
A2セルに*2706管理表.xls　を含む*を入力しました。
が、やはり何も起きませんでした。。。

他に私が間違っている所等ありますでしょうか？

お礼日時：2015/05/25 21:57

No.8 回答者： hallo-2007 回答日時： 2015/05/24 19:58

それと

buf = Dir(Range("A1").Value & "\*" & Range("A2").Value)
'変数に指定したフォルダにある2706管理表.xlsxで終わるファイル名を入れる
の
’で始まる部分（VBエディターでは緑色に表示される部分）は
コメントアウトと呼ばれてプログラムには全く関係ありません。
後から自分が見直したり、ほかの方が見たときにわかりやすい様に
説明などに使います。
うまくいくようになりましたら、ご自身の言葉でコメントを書くと
勉強になりますし、後々にも役に立ちます。

No.7 回答者： hallo-2007 回答日時： 2015/05/24 17:04

>をコピーすればよかったのでしょうか？

どちらでも構わなかったですが
＞Sub ボタン3_Click()が黄色になったのですが
ひょっとして
Sub Sample1()
の下に
Sub ボタン3_Click()
？
だったら、Sub ボタン3_Click()
を削除と
最後に　End　Subがふたつあったら一つ削除
してください。

コードは　Sub～End　Subの間に記述します。

Sub Sample1()
Dim buf As String
buf = Dir(Range("A1").Value & "\" & Range("A2").Value)
Do While buf <> ""
GYOU = Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks.Open Range("A1").Value & "\" & buf
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = ActiveWorkbook.Sheets("予約と媒体").Range("C3:G33").Value
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
でSample1を実行するか

この回答へのお礼

何度もご教授ありがとうございます。
上記のコードを入力しても作動しないという事はコード以外の何かが間違っているという
ことですかね・・・？
①デスクトップに『管理表集計テスト』名でのフォルダー作成してあり、
場所
C:\Users\私の名前\Desktop
ネットワークパス
\\私の名前\Users\私の名前\Desktop\管理表集計テスト
2つのパスが確認できました
②そのフォルダーの中に『管理表集計』名でのBook＊取り込み先用Book
この中にSheet1のA列１に『\\私の名前\Users\私の名前\Desktop\管理表集計テスト』パスを
書き込み
A列２に『2706管理表.xls*』と書き込み
後は空白になってます。
このBookのマクロにご教授頂いたマクロコードをコピーしてあります。
③同フォルダーの中に『***2706管理表.xlsx』名でのBook＊取り込み元用Book
この中に『予約と媒体』名でのシートあり

エクセルは2007を使用しており、２つのBookはマクロを有効しております。
今現状の設定している状況ですが、何かおかしい点はありましたでしょうか・・・？
何度も申し訳ありませんが宜しくお願い致します。

お礼日時：2015/05/25 14:43

No.6 回答者： hallo-2007 回答日時： 2015/05/24 16:36

A2セルを

2706管理表.xls*
として、どちらでも大丈夫にする方法もありましたね。

No.5 回答者： hallo-2007 回答日時： 2015/05/24 16:22

＞取り込み先のブック名が****.xlsmという名前なんですがここがおかしいという事

そうでしたか、
A2セルの値を .xlsm
に変更して見は如何ですか？

No.4 回答者： hallo-2007 回答日時： 2015/05/24 15:52

何度も訂正で失礼します。

ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU+30).Value=ActiveBook.Sheet("予約と媒体").Rnage("C3:G33").Value
も
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = ActiveWorkbook.Sheets("予約と媒体").Range("C3:G33").Value
3か所もミスがありました。

少し略して

ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = Sheets("予約と媒体").Range("C3:G33").Value
でも大丈夫ですし
もし　シート　予約と媒体　がアクティヴな状態で保存されているなら
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = Range("C3:G33").Value
でも大丈夫です。
一応、エラーはないことを以下で確認しときました。
説明文を除けは、これくらいですみます。
短いと云えば簡単な方です。
テクニックは　Dir関数と
データの入っている最後の行番号を求める
Range("A" & Rows.Count).End(xlUp).Row + 1
の部分です。
これは、参考書に出ているかと思います。

Sub ボタン3_Click()
Dim buf As String
buf = Dir(Range("A1").Value & "\" & Range("A2").Value)
Do While buf <> ""
GYOU = Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks.Open Range("A1").Value & "\" & buf
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = ActiveWorkbook.Sheets("予約と媒体").Range("C3:G33").Value
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub

この回答へのお礼

コードを入れなおしたのですが、Sub ボタン3_Click()が黄色になったのですが
Sub ボタン3_Click()
Dim buf As String
buf = Dir(Range("A1").Value & "\" & Range("A2").Value)
Do While buf <> ""
GYOU = Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks.Open Range("A1").Value & "\" & buf
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = ActiveWorkbook.Sheets("予約と媒体").Range("C3:G33").Value
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
をコピーすればよかったのでしょうか？
それとも
ThisWorkbook.ActiveSheet.Range("A" & GYOU & ":D" & GYOU + 30).Value = Sheets("予約と媒体").Range("C3:G33").Value
の部分だけを最初に組んで頂いたコードと入れ替えれば良かったですか？

お礼日時：2015/05/24 16:34

No.3 回答者： hallo-2007 回答日時： 2015/05/24 15:07

失礼しました。

＞VBエディターでエラーの行にいるが付いていると思います。
は
VBエディターでエラーの行に色が付いていると思います。

それと
＞私の実行させようとしているマクロは複雑なものなのでしょうか・・・・？
結構、高度な部類です。
フォルダー内の不特定のファイルを探し出すのに
Dir（）関数を使っています。
本ではあまり見かけないのでは？？
http://officetanaka.net/excel/vba/tips/tips95.htm
こんなところが参考になると思います。

この回答へのお礼

ご教授ありがとうございます。
エラーは無くなりましたが、実行をしてもウンともスンとも言わないのは
何かが間違っているという事ですよね・・・？
データ元のエクセルをマクロ有効ブックで保存を行い、***2706管理表.xlsxという名前に
なっていてデータ取り込み先のブックのA2には2706管理表.xlsxと打ち込んでいます。
ただ、取り込み先のブック名が****.xlsmという名前なんですがここがおかしいという事であってますでしょうか？
何度もご教授して頂いて本当に申し訳ないですがご回答お願いします。

お礼日時：2015/05/24 15:38

No.2 回答者： hallo-2007 回答日時： 2015/05/24 14:54

VBエディターでエラーの行にいるが付いていると思います。

それを教えてください。

今、ちょっと気が付いた点では

開いたブックを閉じる
の説明文の最初に　'が抜けています
’開いたブックを閉じる
にするか、単なる説明文なので削除して頂いて結構です。