エクセルの集計機能のマクロ

質問

会社の従業員にアンケートをエクセルで送付し、所定の表に回答を入力してもらい、そのエクセルを全従業員(50人)から回収するということを実施しました。
回答フォームは以下の通りでして、同様のフォームに記入された回答が50個のエクセルファイルとして存在します。

配布されたエクセルのフォームは
従業員No.　質問1　 質問2
　　1　　　　　　○　　　　A

といった横3列、縦1行の表となっています。

各人のフォームが同じですので、これを50人分自動集計できるマクロを作成したいと思っています。集計したいイメージは以下の通りです。
従業員No.　質問1　 質問2
　　1　　　　　　○　　　　A
　　2　　　　　　×　　　　D
　　3　　　　　　○　　　　C
　(間、省略)
　　50　　　　　 ×　　　 B

上記のように自動集計するマクロを作成したいのですが、どのようにプログラミングすればよいか分かりません。
いろいろなサイトを見ましたが、奈何せん初心者ですので理解できませんでした。
どなたか分かる方がいらっしゃいましたら、具体的なプログラムをご教授いただけませんか。

回答No.5

rivoisu

ちょっと虫がよすぎやせんか

自分で少しは勉強する。
金だすか（専門家に作ってもらう）
手でしこしこ開いてはコピーして1つのファイルに集約してからここに相談する。

回答No.4

n-jun

＃３です。

＃３のコードは2002で検証した物を拡張子"xlsx"だけ変更しました。
なので2007だと全く違うものなのかも知れません。

そのバージョンをお持ちの方からの回答を待って下さい。

回答No.3

n-jun

＃１です。

＞伊藤一郎.xlsx
たぶん2007なのでしょうね。
もっていないので検証は出来ませんが、

Sub　try()
　Dim　wb　As　Workbook
　Dim　ws　As　Worksheet
　Dim　r　As　Range
　Dim　Pn　As　String,　Fn　As　String

　Application.ScreenUpdating　=　False

　Set　ws　=　ThisWorkbook.ActiveSheet
　Set　r　=　ws.Range("A2")
　ws.Range("A1:C1").Value　=　Array("従業員No.",　"質問1",　"質問2")

　Pn　=　ThisWorkbook.Path　&　"\"
　Fn　=　Dir(Pn　&　"*.xlsx")

　Do　Until　Fn　=　""

　　　　If　Fn　<>　ThisWorkbook.Name　Then
　　　　　　　Set　wb　=　Workbooks.Open(Filename:=Pn　&　Fn)

　　　　　　　'　Sheet1は実際のシート名に変更
　　　　　　　r.Resize(,　3).Value　=　wb.Worksheets("Sheet1").Range("A2:C2").Value
　　　　　　　wb.Close　False
　　　　　　　Set　r　=　r.Offset(1)
　　　　End　If
　　　　Fn　=　Dir()
　Loop
　Set　r　=　Nothing
　Set　wb　=　Nothing
　Application.ScreenUpdating　=　True
End　Sub

コピーを作成してから試して下さい。
従業員Ｎｏの並べ替えは行なってません。
ご参考になれば。

お礼

試してみましたが、うんともすんとも言いません…。
上記プログラムの内容が全く理解できないので、どのように対処したよいのかもわかりません。

回答No.2

n-jun

＃１です。

＞５０個のＥｘｃｅｌファイルと従業員Noの組み付けはどうなっているのでしょう？
勘違いでしたので忘れて下さい。

回答No.1

n-jun

５０個のＥｘｃｅｌファイルと従業員Noの組み付けはどうなっているのでしょう？

補足

Excelファイルの名前は「伊藤一郎.xlsx」といったように自分の氏名に変更してもらい、ファイル内の従業員番号は1,2,…50のうち自分の番号を記入してもらう方式となっています。

以上のファイルをすべて回収し、「伊藤一郎.xlsx」(従業員番号1)、「加藤二郎.xlsx」(従業員番号2)、…、「渡辺花子.xlsx」(従業員番号50)といったファイルが50個同一フォルダに保管されている状況です。