回答編集履歴

1

修正

2021/10/23 08:23

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -2,28 +2,74 @@
2
2
 
3
3
  ```VBA
4
4
 
5
- Sub NameCopy()
5
+ Sub Merge()
6
6
 
7
- Dim i As Long
7
+
8
8
 
9
- Dim ws As Worksheet
9
+ Dim MergeBook As Workbook
10
10
 
11
- i = 1
11
+ Dim CurrentBook As Workbook
12
12
 
13
- For Each ws In ThisWorkbook.Worksheets
13
+ Dim CurrentPath As String
14
14
 
15
- If ws.Name Like "商品*" Then
15
+ Dim Filename As String
16
16
 
17
- ws.Range("AJ1:AK500").Copy Sheets("集計").Cells(i, 1)
17
+ Dim n As Integer
18
18
 
19
+
20
+
21
+ Application.ScreenUpdating = False
22
+
23
+ Set MergeBook = ThisWorkbook
24
+
25
+
26
+
27
+ Dim MergeSheet As Worksheet
28
+
29
+ Set MergeSheet = MergeBook.Worksheets.Add(, MergeBook.Worksheets.Count)
30
+
31
+ MergeSheet.Name = "集計"
32
+
33
+
34
+
35
+ CurrentPath = MergeBook.Path
36
+
37
+ Filename = Dir(CurrentPath & "*.xls?")
38
+
39
+
40
+
41
+ n = 0
42
+
43
+ Do While Filename <> Empty
44
+
45
+ If Filename <> MergeBook.Name Then
46
+
47
+ Set CurrentBook = Workbooks.Open(CurrentPath & "\" & Filename)
48
+
49
+ Dim ws As Worksheet
50
+
51
+ For Each ws In CurrentBook.Worksheets
52
+
53
+ ws.Range("AJ1:AK500").Copy MergeSheet.Range("A" & MergeSheet.Rows.Count).End(xlUp).Offset(1)
54
+
55
+ Next
56
+
57
+ CurrentBook.Close False
58
+
19
- i = i + 500
59
+ n = n + 1
20
60
 
21
61
  End If
22
62
 
63
+ Filename = Dir
64
+
23
- Next
65
+ Loop
66
+
67
+
68
+
69
+ Application.ScreenUpdating = True
70
+
71
+ MsgBox n & "件のブックを処理しました。"
24
72
 
25
73
  End Sub
26
74
 
27
-
28
-
29
75
  ```