フォルダ内に複数ある全エクセルの全シートに共通の処理を行いたい

フォルダ内に複数ある全エクセルの全シートに
共通の処理を行いたいと思っています。

下記のサイトに記載の処理を、
https://iamai101.hatenadiary.com/entry/2012/05/16/131255

下記のサイト記載のコードを用いて
全ファイル分繰り返したいと思っています。
https://rouxchan.com/dir-function/

それぞれであれば問題なく動かせるのですが、
うまく組み合わせられません。
ヒントだけでも良いのでご教示いただけましたら幸いです。

回答1件

ベストアンサー

全ファイル分繰り返しのコード内の「実行させたい処理」のところで「全シート繰り返し」をCallすればいいでしょう。

vba
1Sub Sample1()
2    Dim filepath As String, cnt As Long '変数の宣言
3    Const folderpath  As String = "/Users/○○/Desktop/Sample/" '定数の宣言
4    filepath = Dir(folderpath & "*.*") 'dir関数でフォルダの中のファイル名を返します
5    Do While filepath <> "" '変数に空白が入るまで処理を繰り返す
6    Workbooks.Open (folderpath & filepath) 'ワークブックを開いていく
7'--------実行させたい処理---------
8    
9    Call 全シート繰り返し
10 
11'--------実行させたい処理---------
12    Workbooks(filepath).Close SaveChanges:=True
13    '変数にまだ入力されていないファイル名を格納する
14    filepath = Dir()
15    Loop 'Do While に戻る
16End Sub
17
18Sub 全シート繰り返し()
19
20  Application.ScreenUpdating = False
21    Dim Sht As Worksheet
22        For Each Sht In Worksheets
23            Sht.Select
24            Call 値貼り付け
25        Next Sht
26  Application.ScreenUpdating = True
27End Sub
28 
29Sub 値貼り付け()
30    Cells.Select
31    Selection.Copy
32    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
33        :=False, Transpose:=False
34End Sub

追記
ｰｰｰ
上記コードの改良版

vba
1Sub Sample1()
2    Dim filepath As String         '変数の宣言
3    Const folderpath  As String = "C:\Test\BookLoopTest\" '定数の宣言
4    filepath = Dir(folderpath & "*.xls*")        'dir関数でフォルダの中のファイル名を返します
5    Application.ScreenUpdating = False
6    
7    Dim wb As Workbook
8    Do While filepath <> ""                      '変数に空白が入るまで処理を繰り返す
9        Set wb = Workbooks.Open(folderpath & filepath)   'ワークブックを開いていく
10     
11        Call 全シート繰り返し(wb)
12 
13        Workbooks(filepath).Close SaveChanges:=True
14        '変数にまだ入力されていないファイル名を格納する
15        filepath = Dir()
16    Loop                                         'Do While に戻る
17    Application.ScreenUpdating = True
18End Sub
19
20Sub 全シート繰り返し(wb As Workbook)
21
22    Dim Sht As Worksheet
23    For Each Sht In wb.Worksheets
24        Call 値貼り付け(Sht)
25    Next Sht
26End Sub
27 
28Sub 値貼り付け(Sht As Worksheet)
29    With Sht.UsedRange
30        .Value = .Value
31    End With
32End Sub