teratail
回答率
85.47%
質問するログイン新規登録
トップに関する質問kaVBA 特定シートの抽出 別ブックへのコピー

編集履歴

質問編集履歴

5

誤字

2018/10/06 13:40

投稿

songyong
songyong

スコア21

test CHANGED
File without changes
test CHANGED
@@ -90,7 +90,7 @@
90
90
 
91
91
  ActiveWorkbook.SaveAs _
92
92
 
93
- fileName:="C:\Navigate\forClient\bookName", _
93
+ fileName:="C:\forClient\bookName", _
94
94
 
95
95
  FileFormat:=xlOpenXMLWorkbook
96
96
 

4

書き直し

2018/10/06 13:39

投稿

songyong
songyong

スコア21

test CHANGED
@@ -1 +1 @@
1
- VBA 特定シートの抽出 別ブックへのコピー
1
+ kaVBA 特定シートの抽出 別ブックへのコピー
test CHANGED
@@ -12,11 +12,7 @@
12
12
 
13
13
  問題が2点あります。
14
14
 
15
- ➀二回目以降のループ処理で以下のエラーメッセージが出ます。
15
+ ➀指定しているワークシートが正しく出力されません、一枚のみ出ます。
16
-
17
- 実行時エラー'9' インデックスが有効範囲にありません。
18
-
19
- デバッグしたところ、.copyで落ちているようなので、copy参照先のブックが本来コピーしたブックではなく、一回目のループで作成されたものを見に行っているようです。解決方法(絶対参照方法等)をご教示頂きたいです。
20
16
 
21
17
  ⓶保存時の名前について
22
18
 
@@ -30,87 +26,9 @@
30
26
 
31
27
 
32
28
 
33
- 追記　1
34
-
35
- ActiveSheetを指定したところ、コピーはされるようになったのですが、コピー先がバラバラになってしまいます。Array関数にてどうにか出来ないか調査中です。
36
-
37
-
38
-
39
- 追記　２
40
-
41
- 変更後ソースをアップしました。これでは、オートメーションエラーとなります。
42
-
43
- 現状の問題点は3つです。
44
-
45
- ➀arrayに格納する変数数は動的にしたい。
46
-
47
- ⓶データは取得できるがコピー作成時にオートメーションエラーが発生する
48
-
49
- ③保存するファイル名に変数を使いたいが、分からない。
50
-
51
29
 
52
30
 
53
31
  ```VBA
54
-
55
- 【変更前】
56
-
57
- Option Explicit
58
-
59
-
60
-
61
- Sub シート抽出()
62
-
63
-
64
-
65
- Dim clientName As String
66
-
67
- Dim period As String
68
-
69
- Dim bookName As String
70
-
71
- Dim val As Long
72
-
73
- Dim copySheet As String
74
-
75
-
76
-
77
- clientName = Cells(13, 3).Value
78
-
79
- period = Cells(16, 3).Value
80
-
81
- bookName = clientName & "_" & period
82
-
83
- val = 19
84
-
85
-
86
-
87
- Do While Cells(val, 3).Value <> ""
88
-
89
- copySheet = Cells(val, 3)
90
-
91
- Sheets(copySheet).Copy
92
-
93
- val = val + 1
94
-
95
- Loop
96
-
97
-
98
-
99
- ActiveWorkbook.SaveAs _
100
-
101
- fileName:="C:\forClient\bookName", _
102
-
103
- FileFormat:=xlOpenXMLWorkbook
104
-
105
-
106
-
107
- End Sub
108
-
109
-
110
-
111
-
112
-
113
- 【変更後】
114
32
 
115
33
  Option Explicit
116
34
 
@@ -130,11 +48,11 @@
130
48
 
131
49
  Dim i As Integer
132
50
 
51
+ Dim count As Long
52
+
133
53
  Dim copySheet As String
134
54
 
135
- Dim strData(0 To 3) As String
136
-
137
- Dim varData As Variant
55
+ Dim ary() As String
138
56
 
139
57
 
140
58
 
@@ -142,37 +60,37 @@
142
60
 
143
61
  period = Cells(16, 3).Value
144
62
 
63
+ count = Cells(19, 3)
64
+
145
65
  bookName = clientName & "_" & period
146
66
 
147
- val = 19
67
+ val = 22
148
68
 
149
69
  i = 0
150
70
 
151
71
 
152
72
 
153
- Do While Cells(val, 3).Value <> ""
73
+ ReDim ary(count - 1)
154
74
 
155
- copySheet = Cells(val, 3)
156
75
 
76
+
157
- strData(i) = copySheet
77
+ For i = 0 To count - 1
78
+
79
+ ary(i) = Cells(val, 3)
158
80
 
159
81
  val = val + 1
160
82
 
161
- i = i + 1
162
-
163
- Loop
83
+ Next
164
84
 
165
85
 
166
86
 
167
- varData = Array(strData)
168
-
169
- Sheets(varData).Copy
87
+ Worksheets(ary(count - 1)).Copy Before:=Worksheets(2)
170
88
 
171
89
 
172
90
 
173
91
  ActiveWorkbook.SaveAs _
174
92
 
175
- fileName:="C:\forClient\bookName", _
93
+ fileName:="C:\Navigate\forClient\bookName", _
176
94
 
177
95
  FileFormat:=xlOpenXMLWorkbook
178
96
 

3

追記２

2018/10/06 13:39

投稿

songyong
songyong

スコア21

test CHANGED
@@ -1 +1 @@
1
- VBA 特定シートの抽出 参照ブックが変わってしまう
1
+ VBA 特定シートの抽出 別ブックへのコピー
test CHANGED
@@ -30,15 +30,29 @@
30
30
 
31
31
 
32
32
 
33
- 追記　
33
+ 追記　1
34
34
 
35
35
  ActiveSheetを指定したところ、コピーはされるようになったのですが、コピー先がバラバラになってしまいます。Array関数にてどうにか出来ないか調査中です。
36
36
 
37
37
 
38
38
 
39
+ 追記　２
40
+
41
+ 変更後ソースをアップしました。これでは、オートメーションエラーとなります。
42
+
43
+ 現状の問題点は3つです。
44
+
45
+ ➀arrayに格納する変数数は動的にしたい。
46
+
47
+ ⓶データは取得できるがコピー作成時にオートメーションエラーが発生する
48
+
49
+ ③保存するファイル名に変数を使いたいが、分からない。
50
+
39
51
 
40
52
 
41
53
  ```VBA
54
+
55
+ 【変更前】
42
56
 
43
57
  Option Explicit
44
58
 
@@ -92,4 +106,80 @@
92
106
 
93
107
  End Sub
94
108
 
109
+
110
+
111
+
112
+
113
+ 【変更後】
114
+
115
+ Option Explicit
116
+
117
+
118
+
119
+ Sub シート抽出()
120
+
121
+
122
+
123
+ Dim clientName As String
124
+
125
+ Dim period As String
126
+
127
+ Dim bookName As String
128
+
129
+ Dim val As Long
130
+
131
+ Dim i As Integer
132
+
133
+ Dim copySheet As String
134
+
135
+ Dim strData(0 To 3) As String
136
+
137
+ Dim varData As Variant
138
+
139
+
140
+
141
+ clientName = Cells(13, 3).Value
142
+
143
+ period = Cells(16, 3).Value
144
+
145
+ bookName = clientName & "_" & period
146
+
147
+ val = 19
148
+
149
+ i = 0
150
+
151
+
152
+
153
+ Do While Cells(val, 3).Value <> ""
154
+
155
+ copySheet = Cells(val, 3)
156
+
157
+ strData(i) = copySheet
158
+
159
+ val = val + 1
160
+
161
+ i = i + 1
162
+
163
+ Loop
164
+
165
+
166
+
167
+ varData = Array(strData)
168
+
169
+ Sheets(varData).Copy
170
+
171
+
172
+
173
+ ActiveWorkbook.SaveAs _
174
+
175
+ fileName:="C:\forClient\bookName", _
176
+
177
+ FileFormat:=xlOpenXMLWorkbook
178
+
179
+
180
+
181
+ End Sub
182
+
183
+
184
+
95
185
  ```

2

追記

2018/10/06 12:34

投稿

songyong
songyong

スコア21

test CHANGED
File without changes
test CHANGED
@@ -27,6 +27,14 @@
27
27
  以上、散文で申し訳ございません。
28
28
 
29
29
  どうか、宜しくお願いします。
30
+
31
+
32
+
33
+ 追記　
34
+
35
+ ActiveSheetを指定したところ、コピーはされるようになったのですが、コピー先がバラバラになってしまいます。Array関数にてどうにか出来ないか調査中です。
36
+
37
+
30
38
 
31
39
 
32
40
 

1

誤字修正

2018/10/06 12:11

投稿

songyong
songyong

スコア21

test CHANGED
File without changes
test CHANGED
@@ -76,7 +76,7 @@
76
76
 
77
77
  ActiveWorkbook.SaveAs _
78
78
 
79
- fileName:="C:\Navigate\forClient\bookName", _
79
+ fileName:="C:\forClient\bookName", _
80
80
 
81
81
  FileFormat:=xlOpenXMLWorkbook
82
82