【Excel VBA】 多くのファイルからのコピー貼り付け連続処理
【やりたいこと】
アンケートを取った500個のxlsファイル(ファイル名は"001.xls"~"500.xls"まで、単純に規則的に数字が増えていく)があります。500個のファイルの中身(アンケートのフォーマット)は全て同じで、回答者の「答え」は"アンケート"というシートの"P6:S6"と"A70:AX70"という範囲に数列になって入っています。
この500個のファイルに対して、
(1)シートにはPassword付きの保護がかけてあるので、アンケート回答ファイルを開いたら保護を解除する
(2)"アンケート"というシートの、ある範囲(回答部分の"P6:S6"と"A70:AX70")をコピーし、集計用の別ファイルへ貼り付けていく(×500人分)
(3)集計用の別ファイルに貼り付けるときは、1人目の"P6:S6"範囲の貼り付け先は"D4"、"A70:AX70"の範囲の貼り付け先は"I4"で、2人目はそれぞれ"D5"と"I5"、3人目は"D6"と"I6"、・・・とずらしていきます。(コピー元のセルは同じで、コピー先のセルがずれていきます)
(4)コピー貼り付けが終わったアンケート回答は、上書き保存をせずに終了する(再び保護がかかった状態に戻して終了する)
という操作を行うマクロを組みたいのです。
【つまづいている現状・・・】
とりあえず1人目の分だけ記録したマクロは以下の通りです。力技でやろうとすれば、"001.xls"を001~500まで、"D4"と"I4"を4~503まで、ずっと書き変えていけばいいんだと思いますが・・・。500人分を簡単にスッキリとまとめることはできませんでしょうか?
何卒よろしくお願い致します。
--------------------------------------------------------------
Workbooks.Open Filename:="D:\AAA\001.xls"
Sheets("アンケート").Select
ActiveSheet.Unprotect Password:="1234"
Range("P6:S6").Select
Selection.Copy
Windows("集計用ファイル.xls").Activate
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("001.xls").Activate
ActiveWindow.SmallScroll Down:=8
Range("A70:AX70").Select
Application.CutCopyMode = False
Selection.Copy
Windows("集計用ファイル.xls").Activate
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("001.xls").Activate
Application.DisplayAlerts = False
ActiveWindow.Close
--------------------------------------------------------------