フォルダ内の複数ファイルについて、複数シート全て値のみ貼り付けする方法

質問タイトルにあるように、任意のファイルを選択して、その中にある全ての（50個以上）ファイルの中のシート全て値のみ貼り付けする方法を教えていただけないでしょうか？

下記のプログラムを元に、少し変えたいです。
・フォーマットという名前のフォルダではなく、任意に選択したフォルダにしたいです。
・ファイルの中にあるシートは”確認用”だけでなく、開くファイルによって60ぐらいシートがあるものもあり、”存在するシート全て”にしたいです。

ご迷惑をおかけしますが、宜しくお願い致します。

---

Sub Sample()
Dim buf As String
Dim fPass as String

fPass=Thisworkbook.pass & "\フォーマット\"
buf = Dir(fPass & "*.xls")

Do While Len(buf) > 0
Workbooks.open Filename:=fPass & buf, UpdateLinks:=0
Worksheets("確認用").Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(buf).save
Workbooks(buf).close
buf = Dir()
Loop

End Sub

No.2 回答者： Qchan1962 回答日時： 2021/07/02 22:42

こんばんは、

ブックの拡張子、古いみたいだけれど、、良いのでしょうか？
値貼り付けでなければ処理は簡単だけれど、、値のみ、、ですかね

コピーしたシートに値貼り付けしているようですけれど貼り付けは、新規シートで良いのですか？

最大300シート位できると言う事になりそうですが、、大丈夫？
シート名は変えずで良いの？重複した時は？

やり取りする時間が無いと思うので、　サンプルを
Sub Sample()
Dim folPath As String, buf As String
Dim MyBk As Workbook
Dim Ws As Worksheet
Set MyBk = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
folPath = .SelectedItems(1)
End If
End With
If folPath = "" Then Exit Sub
Application.ScreenUpdating = False
buf = Dir(folPath & "\*.xls*")
Do While Len(buf) > 0
With Workbooks.Open(Filename:=folPath & "\" & buf)
For Each Ws In .Worksheets
Ws.Cells.Copy
MyBk.Activate
MyBk.Worksheets.Add after:=Worksheets(Worksheets.Count)
MyBk.ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next Ws
.Close SaveChanges:=False
End With
buf = Dir()
Loop
Application.ScreenUpdating = True
End Sub

未検証ですが、参考まで

この回答へのお礼

ご丁寧に、ありがとうございます！
元のコードの不備まで指摘してくださり、ありがとうございます。。
記載いただいたコードを拝見し、やってみます。

ちなみに、新規シートではなくて大丈夫です。
そうなんです。。とてもたくさんのシートを値張りしていかなければならず。
このマクロを使う前に、名前の設定などは済ませておくつもりです！

お礼日時：2021/07/06 11:59

No.1 回答者： fujillin 回答日時： 2021/07/02 22:24

こんばんは

＞任意に選択したフォルダにしたいです。
フォルダ指定のダイアログ等を用いて選択するようにしてはいかがでしょうか？
例えば、
With Application.FileDialog(msoFileDialogFolderPicker)
　If .Show = True Then folderPath = .SelectedItems(1)
End With
みたいな感じ。

＞”存在するシート全て”にしたいです。
ブック内のシートをループで処理すれば良いのでは？
例えば、当該ブックがアクティブな状態とするなら、
For Each sht In ActiveWorkbook.Worksheets
　sht.UsedRange.Cells.Value = sht.UsedRange.Cells.Value
Next sht
とか。

この回答へのお礼

お答えいただき、ありがとうございます！こちらを組み合わせてやってみます。

お礼日時：2021/07/06 11:53