VBA フォルダ内ファイルにマクロ一括処理

質問

フォルダ内ファイルのマクロを一括実行したいです。

フォルダ内ファイル全てに下記のマクロを登録
Sub 値貼り付け()

'シート4番目を選択
Sheets(4).Select
'シート名1文字目が「★」以外のシートを選択
For Each i In ThisWorkbook.Sheets
If Not i.Name Like "★*" Then
i.Select Replace:=False
End If
Next i
'全セル選択
Cells.Select
'コピー
Selection.Copy
'値貼り付け
Selection.PasteSpecial Paste:=xlPasteValues
Cells(1, 1).Select
Sheets(1).Select
'「.xlsx」で保存
Application.DisplayAlerts = False
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
With ActiveWorkbook
f = fso.GetBaseName(.Name)
.SaveAs .Path & "\" & f & "保存.xlsx", FileFormat:=xlWorkbookDefault
.Close
End With
Set fso = Nothing
End Sub

一括でマクロを実行する用のファイルに下記マクロを登録
Sub 一括処理()

Dim Fpath As String
Dim Fname As String
Dim Wb As Workbook
Fpath = ThisWorkbook.Path & "\"
Fname = Dir(Fpath & "*.xlsm")
Do Until Fname = ""
If Fname = ThisWorkbook.Name Then
Else
Application.DisplayAlerts = False
'ブックを開く
Set Wb = Workbooks.Open(Fpath & Fname)
'マクロ実行
Application.Run "'" & Fname & "'!値貼り付け"
Wb.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
Fname = Dir()
Loop
End Sub

一括処理の実行をすると、フォルダ内の一つのファイルだけ
マクロ実行されると終了してしまいます。
各々のファイルには他にもマクロを登録していて、そちらは
'マクロ実行
Application.Run "'" & Fname & "'!値貼り付け"
のマクロの名前部分を変更して、同様に一括処理していますが
問題なく動きます。
なぜかこの「値貼り付け」のマクロだけ全ファイルに動作して
くれません。
色々自分なりに調べているのですが、どうしても原因不明で
今回投稿させて頂きました

回答No.1

luka3 · ベストアンサー

マクロ呼び出しが１つだけ処理されて返ってこない理由は追及していませんが、これくらいの処理であれば、呼び出し側で処理した方が早いのではないかと思います。
気になるのは『「★」以外のシートを選択』で、対象シートが複数あってもForで回した最後のシートだけが処理されることになりますが、それで合ってます？ 対象シートは１つしかないのかな。

Sub 一括処理()
Dim Fpath As String
Dim Fname As String
Dim Wb As Workbook
Fpath = ThisWorkbook.Path & "\"
Fname = Dir(Fpath & "*.xlsm")
Do Until Fname = ""
If Fname <> ThisWorkbook.Name Then
Application.DisplayAlerts = False
'ブックを開く
Set Wb = Workbooks.Open(Fpath & Fname)
'シート名1文字目が「★」以外のシートを選択
Dim i
For Each i In Wb.Sheets
If Not i.Name Like "★*" Then
i.Activate
End If
Next i
'全セル選択
Cells.Select
'コピー
Selection.Copy
'値貼り付け
Selection.PasteSpecial Paste:=xlPasteValues
Cells(1, 1).Select
Sheets(1).Select
'「.xlsx」で保存
Wb.SaveAs Wb.Path & "\" & Replace(Wb.Name, ".xlsm", "保存.xlsx"), FileFormat:=xlWorkbookDefault
Wb.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
Fname = Dir()
Loop
End Sub

お礼

この度は返信ありがとうございました。
本日会社でアドバイス頂、いたコードで無事やりたいことが
実行出来ました。
呼び出し側で処理するという方向性に全く意識がなく、別の
方向性を示して頂けたことで解決に結びつきました。
対象シートは複数ある為（ファイルによりシート数は可変）
『「★」以外のシートを選択』を書いてました。
単独のファイルでマクロ実行する分には、最後のシートだけでなく
全てのシートで値貼り付けが出来ていました。
今週ずっとこのマクロで悩んでいましたので、とても助かりました。
ありがとうございました。

回答No.3

kkkkkm

回答No.2の追加です。

両方でCloseしてるからおかしくなっていると回答しましたが

Sub 値貼り付け()
で
.Close
した時点でマクロ事態(呼び出した方も)が終了してます。

以下のような感じでCloseがEndの役割

Sub Test1()

Test2
MsgBox "test1"

End Sub

Sub Test2()
MsgBox "test2"
End
MsgBox "EEE"
End Sub

ですので
Sub 値貼り付け()
の
.Close
をやめたら次々と一括実行されると思います。

お礼

この度はご回答ありがとうございました。
デバックでコードをチェックしていた際に、マクロが終了
してしまう原因が分かりました。
今回記載したコードは検索して見つけたものを、自分で
やりたいことに合わせて書き換えたもので、きちんと
コードの意味を知ることが必要だと痛感しました。
マクロはまだ使い始めたばかりで、ご返信は大変参考に
なりました。
新しい職場の業務改善の為に、まだまだこれからなので
勉強していきたいと思います。

回答No.2

kkkkkm

Sub 値貼り付け()
で
.Close
して
Sub 一括処理()
で
Wb.Close SaveChanges:=True
としているのでおかしくなるのだと思います。

Sub 値貼り付け()
の
.Close

をやめてみてはいかがでしょう。