回答編集履歴

4

コード修正

2020/12/01 05:44

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -1,8 +1,6 @@
1
1
  `.Row`が余分ですね。Rowは何行目かという数値ですのでそのエラーになります。
2
2
 
3
3
  あと、`Worksheets(1)` は `Worksheets(i)`じゃないですか。
4
-
5
-
6
4
 
7
5
 
8
6
 
@@ -13,3 +11,77 @@
13
11
  ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0).PasteSpecial xlValues
14
12
 
15
13
  ```
14
+
15
+ コメントを受けて追記
16
+
17
+ ---
18
+
19
+ さらに、Range や Cells の中の Range("A2") や Rows.Count もブック.シートを指定しないと、エラーになりますね。
20
+
21
+
22
+
23
+ ```vba
24
+
25
+ For i = 1 To Workbooks(事業所別コード社員一覧).Worksheets.Count
26
+
27
+ With Workbooks(事業所別コード社員一覧).Sheets(i)
28
+
29
+ .Range("A2", .Range("A2").End(xlToRight).End(xlDown)).Copy
30
+
31
+ End With
32
+
33
+ With ThisWorkbook.Worksheets(1)
34
+
35
+ .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlValues
36
+
37
+ End With
38
+
39
+ Next
40
+
41
+ ```
42
+
43
+
44
+
45
+ ちょっとコードが読みづらくなるので、ここは変数をうまく使うとぐっと読みやすくなります。
46
+
47
+
48
+
49
+ ```vba
50
+
51
+ Sub まとめるマクロ()
52
+
53
+
54
+
55
+ Dim 事業所別コード社員一覧 As String
56
+
57
+ 事業所別コード社員一覧 = Dir("C:\TEST\test1.xlsm")
58
+
59
+
60
+
61
+ Dim fromWB As Workbook
62
+
63
+ Set fromWB = Workbooks.Open(事業所別コード社員一覧)
64
+
65
+
66
+
67
+ Dim toWS As Worksheet
68
+
69
+ Set toWS = ThisWorkbook.Worksheets(1)
70
+
71
+
72
+
73
+ Dim i As Integer
74
+
75
+ For i = 1 To fromWB.Worksheets.Count
76
+
77
+ fromWB.Sheets(i).Range("A2", fromWB.Sheets(i).Range("A2").End(xlToRight).End(xlDown)).Copy
78
+
79
+ toWS.Cells(toWS.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlValues
80
+
81
+ Next
82
+
83
+
84
+
85
+ End Sub
86
+
87
+ ```

3

書式の改善

2020/12/01 05:44

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -6,7 +6,7 @@
6
6
 
7
7
 
8
8
 
9
- '''vba
9
+ ```vba
10
10
 
11
11
  Worksheets(i).Range("A2", Range("A2").End(xlToRight).End(xlDown)).Copy
12
12
 

2

コード修正

2020/12/01 05:11

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -8,6 +8,8 @@
8
8
 
9
9
  '''vba
10
10
 
11
+ Worksheets(i).Range("A2", Range("A2").End(xlToRight).End(xlDown)).Copy
12
+
11
- ThisWorkbook.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0).PasteSpecial xlValues
13
+ ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0).PasteSpecial xlValues
12
14
 
13
15
  ```

1

コード修正

2020/12/01 03:23

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -8,6 +8,6 @@
8
8
 
9
9
  '''vba
10
10
 
11
- ThisWorkbook.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0).PasteSpecial (xlValues)
11
+ ThisWorkbook.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0).PasteSpecial xlValues
12
12
 
13
13
  ```