複数のエクセルブックを開かず特定シートのセル抽出

質問

他の方の質問を参考に自作しましたが動作に時間が掛かる為、教えて下さい。
　PCはWin10、エクセル2016、ファイル形式はxlsm
　該当フォルダはネットワーク上\\○○○○\Users\ この中に複数ブックが存在
　抽出したいデータは全てのブックの「メニュー」というSheetのA100からAO100までを
　「集計.xlsm]のSheet1の２行目から抽出結果をA２からAO2までを２行目、３行目とずらして値で貼り付けたい
作成したVBAを見て良い方法をご教授下さい。
Sub 集約()
Dim myFolder As Variant
Dim fso As Object
Dim GetFolder As Object
Dim Fol As Object
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
myFolder = .SelectedItems(1)
End If
End With
With CreateObject("WScript.Shell")
.CurrentDirectory = myFolder
End With
Set GetFolder = fso.GetFolder(myFolder)
For Each Fol In GetFolder.SubFolders
Debug.Print Fol.Name
Next
Set GetFolder = Nothing
'フォルダの場所を変数に入れる
Dim Folder_path As String
Folder_path = Range("a1").Value
'集計先のシートを指定し、変数に入れる
Dim w
Set w = Worksheets("sheet1")
'集計するブックを変数に入れる
Dim Merge_book As String
Merge_book = Dir(Folder_path & "\*.xlsm*")

'いったん数値をクリア
w.Range("b" & Rows.Count).Clear

'集計先のシートの1行からスタート
Dim n
n = 4

'指定したフォルダから、Excelファイルを探す
Do Until Merge_book = ""
Workbooks.Open FileName:=Folder_path & "\" & Merge_book

'見つかったら、A列にファイル名、B列に集計値を入れる
w.Range("a" & n).Value = Merge_book
w.Range("b" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("a100").Value
w.Range("c" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("b100").Value
w.Range("d" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("c100").Value
　　　・・・・・・・・・・・・・・・省略・・・・・・・・・・・・・　
　　　　　　　　　　　　　　　　　　　　　　　・
("ao100").Value
w.Range("ap" & n).Value = Workbooks(Merge_book).Worksheets("メニュー").Range

'次の行へ
n = n + 1

'集計するブックを閉じる
Workbooks(Merge_book).Close

'次のファイルを探しに行く
Merge_book = Dir()
Loop

End Sub
この方法は１つのフォルダ直下に全てのブックを入れないと動かないのでPCの容量に負担が掛かり画面もチラチラし、時間も掛かる為、もっと効率的な方法で作業を行いたいのです。
よろしくお願いいたします。

回答No.1

kkkkkm · ベストアンサー

以下のサイトを参考にしてください。
ブックを開かないでセルのデータを読む
http://officetanaka.net/excel/vba/tips/tips28.htm
ブックを開かずにセル値を取得
https://excel-ubara.com/excelvba5/EXCELVBA242.html

お礼

返事が遅くなりましてごめんなさい。母親の葬儀でドタバタしてまして
教えて頂いたものでやってみます。
ありがとうございました。

回答No.3

masnoske

Application.ScreenUpdating の設定をされてはどうでしょうか。
ExcelVBA では、画面を表示する部分に時間がかかります。

こちらを参考に
http://officetanaka.net/excel/vba/speed/s1.htm

その他の高速化テクニックは、こちらを参考に
http://officetanaka.net/excel/vba/speed/

回答No.2

kkkkkm

なお、データの代入先と代入元の範囲が同じ幅と高さでセル数が同じでしたら
一行で代入できます。
w.Range(Cells(n, "B"), Cells(n, "AP")).Value = Workbooks(Merge_book).Worksheets("メニュー").Range("A100:AO100").Value