エクセルVBAに関しての質問です。

質問

エクセルVBAに関しての質問です。

同じフォルダ内に同形式のエクセルファイルが複数あります。そのファイルの特定のシートの中の特定の列のみをコピーして並べたいと思っています。

(1)フォルダはUSBに入れて使ったり、複数のパソコンの中で使われるので特定の場所にあるとは限りません。
(2)フォルダ名はその年度に応じて変更されます。「2009」、「2010」・・・といった具合です。
(3)フォルダ内のファイル数は常に３つで、「記録集計第1期」「記録集計第2期」「記録集計第3期」と名前を付けています。
(4)３つのファイル全てに「結果」という名前のシートがあり、そのシートのC4～AU37までのセルをコピーしたいです。
(5)C4～AU37までのセルには数値では無く、IF関数を使用して出された「◎」「◯」「△」等の文字列が入っています。
(6)コピーしたセルを「記録集計第3期」ファイルの中の「年度末結果」というシートのC2以降に並べてコピーしたいです。ただし、コピーする際に４行ずつ飛ばしてコピーしたいです。
「記録集計第1期」のC4を「年度末結果」のC2へ、C5をC6へ......
「記録集計第2期」のC4を「年度末結果」のC3へ、C5をC7へ......
「記録集計第3期」のC4を「年度末結果」のC4へ、C5をC8へ......
といった具合です。
このコピーにより、C2から始まって、C2=記録集計第1期のC4、C3=記録集計第2期のC4、
C4=記録集計第3期のC4ときて、年度末結果のC5には空白の列ができます。
そして、C6からまた続く訳です。
ややこしくてすみません。
(7)作業手順としては、「記録集計第3期」のファイルだけを開き、その中の「年度末結果」のシートにボタンを作って上記のVBAを動かせたらと思っています。
(8)「記録集計第1期」「記録集計第2期」のファイルは開かずにデータをコピーしたいです。

勝手なお願いで申し訳ございませんが、
お時間がございましたら、よろしくお願いいたします。

回答No.2

ap_2

ANo.1確認しました。間違ってた＾＾；
ついでに、ファイルチェックも入れときました。

Sub test()
Dim r1, r2, c, i
'ファイルチェック入れてみた
If (Dir("記録集計第1期.xls") = "") Or (Dir("記録集計第2期.xls") = "") Then
MsgBox ("ファイルがないよ")
Exit Sub
End If

'コピー処理
For c = 3 To 47 'colループ
For i = 0 To 33 'rowループ
r1 = i * 4 + 2
r2 = i + 4
Cells(r1, c) = ExecuteExcel4Macro("'[記録集計第1期.xls]年度末結果'!R" & r2 & "C" & c)
Cells(r1 + 1, c) = ExecuteExcel4Macro("'[記録集計第2期.xls]年度末結果'!R" & r2 & "C" & c)
Cells(r1 + 2, c) = Worksheets("年度末結果").Cells(r2, c)
Next
Next

End Sub

お礼

面倒な質問に丁寧に答えていただき、ありがとうございます。
近日中に試してみたいと思います。

試した結果も含めて、
また報告させて頂きたいと思います。

取り急ぎ、お礼まで。

ありがとうございました。

回答No.1

ap_2

あれ・・・昨日投稿したつもりだったんだけど。。

ExecuteExcel4Macroで、開かずにコピーできますよ。

ファイルパスは相対参照で指定できます。
.Valueは計算後の値、.Fomulaで計算式、と区別して取得できるので、
セルに式が入っていても関係ないです。

試してないので間違ってたらごめんね↓

(書式)
　ExecuteExcel4Macro("'C:\dir\[file.xls]Sheet1'!R1C1")

(参考)
for c = 3 to 50 'colループ AUって50くらい？
for i = 0 to 33 'rowループ
r1 = i * 4 + 2
r2 = i + 4
Cells(r1, c) = ExecuteExcel4Macro("'[記録集計第1期.xls]年度末結果'!R"& r2 & "C" & c)
Cells(r1+1, c) = ExecuteExcel4Macro("'[記録集計第2期.xls]年度末結果'!R"& r2 & "C" & c)
Cells(r1+2, c) = Sheet("年度末結果").Cells(r2, c)
next
next