回答編集履歴

2

修正

2022/09/10 01:14

投稿

jinoji
jinoji

スコア4585

test CHANGED
@@ -2,6 +2,7 @@
2
2
 
3
3
  <追記>
4
4
  ・元ファイルの指定の箇所を少し修正。
5
+ ・値貼り付けでなく元シートのコピーに変更。
5
6
 
6
7
  ```VBA
7
8
  Sub call_folder_all_file_process()
@@ -25,16 +26,20 @@
25
26
  FName = Dir(Path & "*.xlsx") 'ワイルドカード(*)を使用し、xlsx拡張子のファイルを全て
26
27
 
27
28
  '■Loopでファイルを取得→開く→処理→保存→閉じる
29
+ Application.DisplayAlerts = False
28
30
  Do While FName <> ""
29
31
  Dim wb As Workbook, ws As Worksheet
30
32
  Set wb = Workbooks.Open(Path & FName)
31
33
  Set ws = wb.Worksheets(1)
34
+
32
- motoRange.Copy
35
+ motoSheet.Copy Before:=ws
33
- ws.Range(motoAddr).PasteSpecial xlPasteValues
36
+ ws.Delete
37
+
34
38
  wb.Save
35
39
  wb.Close
36
40
  FName = Dir()
37
41
  Loop
42
+ Application.DisplayAlerts = True
38
43
 
39
44
  End Sub
40
45
  ```

1

修正

2022/09/06 10:13

投稿

jinoji
jinoji

スコア4585

test CHANGED
@@ -1,15 +1,22 @@
1
1
  とりあえず雰囲気だけ。
2
+
3
+ <追記>
4
+ ・元ファイルの指定の箇所を少し修正。
2
5
 
3
6
  ```VBA
4
7
  Sub call_folder_all_file_process()
8
+
5
-
9
+ '■変数準備
10
+ Dim motoBook As Workbook
11
+ Dim motoSheet As Worksheet
12
+ Dim motoRange As Range
6
- Dim motoSheet As String, motoAddr As String
13
+ Dim motoAddr As String
7
- motoSheet = "元シート"
14
+
8
- motoAddr = "A1:Z100"
9
-
10
15
  '■コピー元の範囲
11
- Dim rng As Range
16
+ Set motoBook = Workbooks.Open("C:\Users\user\Desktop\レジ\ジャンル.xlsx")
12
- Set rng = ThisWorkbook.Worksheets(motoSheet).Range(motoAddr)
17
+ Set motoSheet = motoBook.Worksheets(1)
18
+ Set motoRange = motoSheet.UsedRange
19
+ motoAddr = motoRange.Address
13
20
 
14
21
  '■ファイル名取得するフォルダパス、該当拡張子を入れる
15
22
  Dim Path As String
@@ -22,7 +29,7 @@
22
29
  Dim wb As Workbook, ws As Worksheet
23
30
  Set wb = Workbooks.Open(Path & FName)
24
31
  Set ws = wb.Worksheets(1)
25
- rng.Copy
32
+ motoRange.Copy
26
33
  ws.Range(motoAddr).PasteSpecial xlPasteValues
27
34
  wb.Save
28
35
  wb.Close
@@ -30,5 +37,4 @@
30
37
  Loop
31
38
 
32
39
  End Sub
33
-
34
40
  ```