VBA どのように記述すれば良いか教えてください。

質問

はじめて、質問させていただきます。
まだExcel ＶＢＡの勉強を始めたばかりの者です。
下記のようなツールを作ることになったのですが、非常に困っています。どなたかわかる方がみえましたら、どうか教えて下さい。（Excel2003を利用）

＜すべてＡという同じフォルダ内＞
book1.xls
book2.xls
・
　・
book*.xls　→ファイル数は変動します。集計.xls以外のファイルはすべて同じシート名で構成されて
　　　　　　　　います。すべてのファイルのシート名　”結果”が対象です。

集計.xls　→このファイルにマクロを作りたいです。
　　　　　　　シート名が１、２、３・・と１１６まで用意されています。
__________________________________________________________________________________________________________________________________

Ａフォルダ内の複数ファイルの同じシート名（”結果”）というシートのみコピーをし、同じフォルダ内のファイル「集計.xls」のシートへ値貼り付けをしたいのですが、
一番初めにコピーしたシートを「集計.xls」の１という名のシートへ値貼り付け、２番目にコピーしたシートは「集計.xls」の２という名のシートへ値貼り付け。。３番目にコピーしたシートは「集計.xls」の３という名のシートへ値貼り付け。。というのを、シート数分繰り返す。。という記述を教えて頂きたいのです。
ループ？？ですが、【一番初めにコピーしたシートを「集計.xls」の１という名のシートへ値貼り付け】
次に【２番目にコピーしたシートは「集計.xls」の２という名のシートへ値貼り付け】というのを一連の流れにしてループ処理したいのです。

こんなこと出来るのでしょうか？？

　初心者とはいえ丸投げは駄目だと、１週間ほどネットやいろいろなテキストで自分で何とかできないかと頑張ってみたのですが、部分部分しか記述できず時間だけが過ぎていき。。すっかり行き詰ってきてしまいました。

どうかお力を貸してください。宜しくお願い致しますm（uu）m

回答No.1

blue_rumble · ベストアンサー

サンプルのコードをご紹介します。

注意点は下記の通りです。
・「book*.xls」の*は、１から始まる連番であること、また半角であること。
　2や3から始まる場合、また1・2・3・5などの場合はうまく処理できません。

・集計BOOKのシート名も１から始まる連番であること、また半角であること。

・格納フォルダ名やファイル名（「book」部分）が変更になる場合は
　変数にセットする文字列も変更して下さい。

指定された対象フォルダーを検索してファイル名を取得し処理を行ったり
集計BOOKのシートも自動でその都度自由に作成したりすることもできますが
質問者さんはご自分で勉強しながらという姿勢をお持ちのようでしたので
あえて「ベタ」なマクロにしています。
今後、少しずつ覚えながら工夫していって下さい。

では、頑張って下さい！

※※回答内容確認画面では、ソースコードのインデントがうまく表示されず
　　左揃えになっています。（恐らく確認後もそうなると思われる）
　　見にくいかも知れませんが、コピペ後に適切にインデント設定をして下さい。

Sub Sample_Macro()
'
' フォルダー内のBookファイルを順に開き、「結果」シートの内容を取得
' 当Bookファイル（集計）のシートにその内容を展開する
'

' 変数の定義

' -------------------------------対象フォルダー設定用変数
Dim FolderName As String
' -------------------------------対象ファイル設定用変数１（「book」部分）
Dim Filename As String
' -------------------------------ループ用変数（兼「book*.xls」の「*」部分用）
Dim FileCounter As Integer
' -------------------------------対象ファイル設定用変数２（「book*.xls」）
Dim TargetName As String

'
' -------------------------------処理対象フォルダー名をセット（末尾に「\」付加）
FolderName = "D:\A\"
' -------------------------------処理対象ファイル名（前半固定部分）をセット
Filename = "book"
' -------------------------------ループ用カウンターを初期化
FileCounter = 0

' --------------------------------------------------画面更新OFF
Application.ScreenUpdating = False
' --------------------------------------------------警告画面表示OFF
Application.DisplayAlerts = False

' --------------------------------------------------ループ処理開始
Do
FileCounter = FileCounter + 1
' --------------------------------------------------対象ファイル名の組み立て
TargetName = Filename & FileCounter & ".xls"

' --------------------------------------------------対象ファイルの存在チェック
' 　　　　　　　　　　　　　　　　　　　　　　　　　　存在しなければ下記の処理結果表示処理へ
If Dir(TargetName) <> "" Then
' **************************************************
' 　　対象ファイルが存在するためコピー処理開始
' **************************************************

' ----------------------------------------------対象ファイルをオープン
Workbooks.Open FolderName & TargetName
' ----------------------------------------------対象シートを選択
Sheets("結果").Select
' ----------------------------------------------対象シート全てを選択しコピー
Cells.Select
Selection.Copy
' ----------------------------------------------集計用ファイルを選択
Windows("集計.xls").Activate
' ----------------------------------------------貼り付け用シートを選択（「book*.xls」の「*」部分）
Sheets(FileCounter).Select
' ----------------------------------------------コピー内容を貼り付け
Cells.Select
ActiveSheet.Paste
' ----------------------------------------------対象ファイルをクローズ
Workbooks(TargetName).Close
Else
' **************************************************
' 　　対象ファイルが存在しないため
' 　　終了メッセージを表示し処理を終了
' **************************************************

' ----------------------------------------------ループ件数をチェック
If FileCounter > 0 Then
' ----------------------------------------------１件以上の処理が実施された場合は、処理件数を表示
MsgBox FileCounter - 1 & " ファイルの処理が完了しました"
Else
' ----------------------------------------------処理が実施さなかった場合は、対象ファイルが存在しないことを表示
MsgBox "対象ファイルが存在しません"
End If
' ----------------------------------------------ループ脱出
Exit Do
End If
Loop
' --------------------------------------------------画面更新OFF
Application.ScreenUpdating = True
' --------------------------------------------------警告画面表示OFF
Application.DisplayAlerts = True

End Sub

お礼

うわぁぁあ。。
すごいです。。まさかこんなに早く回答を頂けるとは思ってなかったことと、本当に丁寧な解説までして下さって。。感激です（><）ありがとうございます！！
あの。。実は質問の際、付け加え忘れてしまったのですが、book1.xls、book2.xls・・は会社別の名前がついたファイルなのです。でもこれはblue_rumbleさんの回答にあったように「ファイル名（「book」部分）が変更になる場合は変数にセットする文字列も変更して下さい。」で対応出来る（出来るのか不安ですが頑張ります！）と思いますが、Aフォルダの中のファイルは100近くある時もあるので、フォルダを開かないで「集計表.xls」のみ開いてマクロを実行したいのです。。充分すぎる回答頂いて再質問で恐縮なのですが、もしもお分かりになれば是非教えてくださいm(uu)m m(uu)m

回答No.2

DOUGLAS_

＃blue_rumble さんへ
＞ソースコードのインデントがうまく表示されず
　ＶＢＥ での インデント は 半角スペース によって整えられていますので、こういう掲示板に コピペ されるときには、一旦、メモ帳 などで「半角スペース×２個」→「全角スペース×１個」に置換されるとよいです。

　さて、noirff さんへ
＞質問の際、付け加え忘れてしまったのですが。。。
　折角の良回答も無駄になってしまいますねぇ～。。。

　ところで、お尋ねの件では、
１）Ａフォルダ 内の ファイル をどうやって総ざらえするか
２）各ファイル の「結果」シート を「集計.xls」にどうやって コピー するのか
が問題になるかと存じます。

　(１) に付きましては、[Dir 関数] を利用するのが普通かと存じます（ただし、#1さんがお示しの用途とは異なります）。
　コードウィンドウ に「dir」と書いて [F1] キー を押下すると、[Dir 関数] の ヘルプ が開きますので、ご参考にご覧ください。

　(２) に付きましては、「結果」シート に 他のシート を参照するような計算式があるのかないのかによっても操作の難易度が変わってくるかと存じますが、
＞シート名が１、２、３・・と１１６まで用意されています。
とお書きのように、予め １１６ もの シート を用意しておいて、そこに コピー するというよりは、「結果」シート 自体（内容ではなくて、シート そのもの）をそのまま「集計.xls」に コピー して、リネイム する方が簡単かと存じます（この点に付きましては、noirff さんの用途にもよりましょうから、何とも申せませんが。。。）。

　ということで、下記のような具合で、「集計.xls」に Ａフォルダ 内のすべての「*.xls」ファイル の「結果」シート を コピー できます（ただし、コピー 後の シート名 は元の ファイル名）。

１）「Aフォルダ」がどこなのかを指定
２）画面更新の抑止
３）「Aフォルダ」内の "*.xls" ファイル の総ざらえ開始
４）コピー元 の ファイルを開く（ただし、「集計.xls」以外）
５）「結果」シート が存在しない場合の エラートラップ
６）「結果」シート を「集計.xls」にそのまま コピー
７）「結果」シート が存在する場合は「Err.Number = 0」となるので、
　　コピー された「結果」シート の名前を コピー元 のファイル名 にリネイム
８）コピー元 のファイル を閉じる
９）次の ファイル を探す
10）画面を更新

Sub macro()
　Const Aフォルダ As String = "D:\hoge\"
　Dim myName As String
　Application.ScreenUpdating = False
　myName = Dir(Aフォルダ & "*.xls")
　Do While myName <> ""
　　If myName <> ThisWorkbook.Name Then
　　　Workbooks.Open Aフォルダ & myName
　　　On Error Resume Next
　　　Workbooks(myName).Worksheets("結果").Copy After:=ThisWorkbook.Worksheets(1)
　　　If Err.Number = 0 Then
　　　　ActiveSheet.Name = Replace(myName, ".xls", "")
　　　End If
　　　On Error GoTo 0
　　　Workbooks(myName).Close
　　End If
　　myName = Dir
　Loop
　Application.ScreenUpdating = True
End Sub

　では、ご健闘をお祈り申します。　　<(_ _)>

お礼

DOUGLAS_さん、順を追った説明に問題点まで本当にありがとうございました。

ご回答下さった、blue_rumbleさん＆DOUGLAS_さんの記述を心の中で（はぁ。。すごいなぁ）を２０回くらい繰り返しながらずっと読んでました。
充分・・もおほんと充分！！です（T0T）
丸投げの質問にご回答下さって、お二人には本当に感謝感謝です！

初めて登録して質問させて頂いたのですが、”ありがとうポイント”というのがあるのを知って、お二人に早速！。。と思ったら一人しか選べないんですね。。！（><）
質問投稿時の心境は、１週間テキストやネットとにらめっこしていたものの、わからなさ過ぎてグッタリ。。本当に助けてほしいと思って、初めて投稿したのですが、こんな丸投げで回答頂けないかも。。
と思っていたら、すぐに回答を頂けて感激しました！(><)
そこでものすごく悩みましたが、最初に回答を下さったblue_rumbleさんにありがとうポイントを贈らせて頂くことにしました。DOUGLAS_さんごめんなさい心苦しいです。でもとても
感謝していますm(uu)mm(uu)m
お二人から教えて頂いた記述を、明日またじっくりにらめっこしながら、VBAの猛勉強します！今度質問するときは丸投げしないように努力したいと思います。
本当にありがとうございました。