回答編集履歴

1

コード追記

2023/06/07 14:25

投稿

hatena19
hatena19

スコア33782

test CHANGED
@@ -35,5 +35,42 @@
35
35
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
36
36
  :=False, Transpose:=False
37
37
  End Sub
38
+ ```
39
+ 追記
40
+ ーーー
41
+ 上記コードの改良版
38
42
 
43
+ ```vba
44
+ Sub Sample1()
45
+ Dim filepath As String '変数の宣言
46
+ Const folderpath As String = "C:\Test\BookLoopTest\" '定数の宣言
47
+ filepath = Dir(folderpath & "*.xls*") 'dir関数でフォルダの中のファイル名を返します
48
+ Application.ScreenUpdating = False
49
+
50
+ Dim wb As Workbook
51
+ Do While filepath <> "" '変数に空白が入るまで処理を繰り返す
52
+ Set wb = Workbooks.Open(folderpath & filepath) 'ワークブックを開いていく
53
+
54
+ Call 全シート繰り返し(wb)
55
+
56
+ Workbooks(filepath).Close SaveChanges:=True
57
+ '変数にまだ入力されていないファイル名を格納する
58
+ filepath = Dir()
59
+ Loop 'Do While に戻る
60
+ Application.ScreenUpdating = True
61
+ End Sub
62
+
63
+ Sub 全シート繰り返し(wb As Workbook)
64
+
65
+ Dim Sht As Worksheet
66
+ For Each Sht In wb.Worksheets
67
+ Call 値貼り付け(Sht)
68
+ Next Sht
69
+ End Sub
70
+
71
+ Sub 値貼り付け(Sht As Worksheet)
72
+ With Sht.UsedRange
73
+ .Value = .Value
74
+ End With
75
+ End Sub
39
76
  ```