複数のエクセルシートのデータを他のブックで集計するマクロについて

Excelマクロ初心者です。どうぞよろしくお願いいたします。

各営業所のデータが入ったエクセルシートを所定のフォルダに入れ、同じフォルダ内にある「サマリー表」にデータを集計するマクロを作成しており、似たような事例が載っていた参考書を見ながら試行錯誤中です。

Cドライブの「4月営業所まとめ」というフォルダ内に各営業所のエクセルシートを入れれば、自動的にリンクで集計するところまでは分かったのですが、これの応用で、サマリーシート内のボタンを押してから集計(データをリンク)するマクロを作成しなくてはならず、以下のマクロではなぜうまくいかないのかが、よくわかりません。


Sub ボタン2_Click()

Sheets("サマリー表").Range("B3") = "C:\4月営業所まとめ\[秋葉原営業所.xlsx]Sheet1'!A2"
Sheets("サマリー表").Range("B4") = "C:\4月営業所まとめ\[新宿営業所.xlsx]Sheet1'!A2"
Sheets("サマリー表").Range("B5") = "C:\4月営業所まとめ\[渋谷営業所.xlsx]Sheet1'!A2"
Sheets("サマリー表").Range("B6") = "C:\4月営業所まとめ\[池袋営業所.xlsx]Sheet1'!A2"
Sheets("サマリー表").Range("B7") = "C:\4月営業所まとめ\[上野営業所.xlsx]Sheet1'!A2"
Sheets("サマリー表").Range("C3") = "C:\4月営業所まとめ\[秋葉原営業所.xlsx]Sheet1'!B2"
Sheets("サマリー表").Range("C4") = "C:\4月営業所まとめ\[新宿営業所.xlsx]Sheet1'!B2"
Sheets("サマリー表").Range("C5") = "C:\4月営業所まとめ\[渋谷営業所.xlsx]Sheet1'!B2"
Sheets("サマリー表").Range("C6") = "C:\4月営業所まとめ\[池袋営業所.xlsx]Sheet1'!B2"
Sheets("サマリー表").Range("C7") = "C:\4月営業所まとめ\[上野営業所.xlsx]Sheet1'!B2"
Sheets("サマリー表").Range("D3") = "C:\4月営業所まとめ\[秋葉原営業所.xlsx]Sheet1'!C2"
Sheets("サマリー表").Range("D4") = "C:\4月営業所まとめ\[新宿営業所.xlsx]Sheet1'!C2"
Sheets("サマリー表").Range("D5") = "C:\4月営業所まとめ\[渋谷営業所.xlsx]Sheet1'!C2"
Sheets("サマリー表").Range("D6") = "C:\4月営業所まとめ\[池袋営業所.xlsx]Sheet1'!C2"
Sheets("サマリー表").Range("D7") = "C:\4月営業所まとめ\[上野営業所.xlsx]Sheet1'!C2"

End Sub

どのように直せばよいのか、ほかの方法がわかる方、申し訳ないですが教えてください。
よろしくお願いいたします。

No.4 回答者： ExcelDevTool 回答日時： 2017/02/12 09:26

No.3 回答者： ママチャリ 回答日時： 2017/02/06 16:36

Sheets("サマリー表").Range("B3") = "C:\4月営業所まとめ\[秋葉原営業所.xlsx]Sheet1'!A2"

　↓
Sheets("サマリー表").Range("B3") = "='C:\4月営業所まとめ\[秋葉原営業所.xlsx]Sheet1'!A2"

No.2 回答者： tom04 回答日時： 2017/02/06 11:53

No.1です。

＞With Worksheets("サマリー表")のところが黄色く反転して動かないです。

ん～～～
今一度こちらでそれぞれのBookを作成し同じコードで試してみました。
（もちろん保存場所はこちらの保存場所のパスに変更して・・・）
ちゃんと動いたのですが、

もしかして、「サマリー表」というシート名が間違っているというコトはないでしょうか？
考えられる原因としては
この程度しか思いつきません。
他の原因ならごめんなさい。

＞解説を付けていただければ幸いです。

流れとしては「サマリー表」シートのA3～A列最終行までループさせ、
そのブックを開きB列以降に開いたブックのA2～D2セルの値を代入する。ｌ
といった感じです。
もう一度コードにコメントを記載したものを載せてみます。

Sub Sample1()
Dim i As Long, wB As Workbook
Dim myPath As String, fN As String
'▼保存場所のパスを決める//
myPath = "C:\4月営業所まとめ" & "\"
'▼画面更新を止める//
Application.ScreenUpdating = False
'▼コード記載Bookの「サマリー表」というシート名の・・・//
With Worksheets("サマリー表")
'▼3行目～A列最終行まで//
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
'▼ブック名を「サマリー表」シートのA列 & 営業所.xlsx　とする//
fN = .Cells(i, "A") & "営業所.xlsx"
'▼保存場所にブックが存在するか確認し、存在する場合はそのブックを開く//
If Dir(myPath & fN) <> "" Then '←念のため//
Workbooks.Open myPath & fN
'▼開いたBookを変数「wB」に格納//
Set wB = ActiveWorkbook
'▼「サマリー表」シートのi行目B～D列の値に、開いたBookのSheet1のA2～D2の値を代入//
.Cells(i, "B").Resize(, 3).Value = wB.Worksheets("Sheet1").Range("A2").Resize(, 3).Value
'▼wBを保存せずに閉じる//
wB.Close savechanges:=False
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

※　コードは前回のコードと全く変えていません。m(_ _)m

No.1 回答者： tom04 回答日時： 2017/02/05 20:21

こんばんは！

「サマリー表」シートにコマンドボタンを配置しているのですね？

まず、↓のコードを標準モジュールにコピー＆ペーストしてください。

Sub Sample1()
Dim i As Long, wB As Workbook
Dim myPath As String, fN As String
myPath = "C:\4月営業所まとめ" & "\"
Application.ScreenUpdating = False
With Worksheets("サマリー表")
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
fN = .Cells(i, "A") & "営業所.xlsx"
If Dir(myPath & fN) <> "" Then '←念のため//
Workbooks.Open myPath & fN
Set wB = ActiveWorkbook
.Cells(i, "B").Resize(, 3).Value = wB.Worksheets("Sheet1").Range("A2").Resize(, 3).Value
wB.Close savechanges:=False
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

次にコマンドボタンのコードを

Private Sub ボタン2_Click()
Call Sample1
End Sub

としてみてください。

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ご回答いただきありがとうございます。
やってみたのですが、「インデックスが有効範囲にありません。」と出て、With Worksheets("サマリー表")のところが黄色く反転して動かないです。(｡´Д⊂)うぅ･･･｡

素人で難しいプログラミングがわからないので、解説を付けていただければ幸いです。

お礼日時：2017/02/05 22:20