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

Question

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

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

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

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

Answer 1

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

Sub Sample1()
    Dim filepath As String, cnt As Long '変数の宣言
    Const folderpath  As String = "/Users/○○/Desktop/Sample/" '定数の宣言
    filepath = Dir(folderpath & "*.*") 'dir関数でフォルダの中のファイル名を返します
    Do While filepath <> "" '変数に空白が入るまで処理を繰り返す
    Workbooks.Open (folderpath & filepath) 'ワークブックを開いていく
'--------実行させたい処理---------
    
    Call 全シート繰り返し
 
'--------実行させたい処理---------
    Workbooks(filepath).Close SaveChanges:=True
    '変数にまだ入力されていないファイル名を格納する
    filepath = Dir()
    Loop 'Do While に戻る
End Sub

Sub 全シート繰り返し()

  Application.ScreenUpdating = False
    Dim Sht As Worksheet
        For Each Sht In Worksheets
            Sht.Select
            Call 値貼り付け
        Next Sht
  Application.ScreenUpdating = True
End Sub
 
Sub 値貼り付け()
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

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

Sub Sample1()
    Dim filepath As String         '変数の宣言
    Const folderpath  As String = "C:\Test\BookLoopTest\" '定数の宣言
    filepath = Dir(folderpath & "*.xls*")        'dir関数でフォルダの中のファイル名を返します
    Application.ScreenUpdating = False
    
    Dim wb As Workbook
    Do While filepath <> ""                      '変数に空白が入るまで処理を繰り返す
        Set wb = Workbooks.Open(folderpath & filepath)   'ワークブックを開いていく
     
        Call 全シート繰り返し(wb)
 
        Workbooks(filepath).Close SaveChanges:=True
        '変数にまだ入力されていないファイル名を格納する
        filepath = Dir()
    Loop                                         'Do While に戻る
    Application.ScreenUpdating = True
End Sub

Sub 全シート繰り返し(wb As Workbook)

    Dim Sht As Worksheet
    For Each Sht In wb.Worksheets
        Call 値貼り付け(Sht)
    Next Sht
End Sub
 
Sub 値貼り付け(Sht As Worksheet)
    With Sht.UsedRange
        .Value = .Value
    End With
End Sub

Comments

[退会済みユーザー]

ありがとうございます。
上記処理を行おうとすると23行目の
Sht.Selectのところで1004エラー
(アプリケーション定義またはオブジェクト定義のエラーです)になってしまいます。。
もし原因が分かればご教示いただくことは可能でしょうか、、！