teratail
回答率
85.48%
質問するログイン新規登録
トップに関する質問行が下に一列ずれてペーストされてしまう　エラー1004

編集履歴

質問編集履歴

3

試したこと追記

2017/12/15 03:23

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -12,7 +12,47 @@
12
12
 
13
13
 
14
14
 
15
-
15
+ 試したこと
16
+
17
+ ペーストされる空白セルの指定法が間違っていると思い。
18
+
19
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
20
+
21
+ を
22
+
23
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
24
+
25
+ や
26
+
27
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
28
+
29
+ や
30
+
31
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
32
+
33
+ や
34
+
35
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
36
+
37
+ にしてみましたが、うまく実行されませんでした。
38
+
39
+
40
+
41
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
42
+
43
+ としたところ、
44
+
45
+ エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
46
+
47
+ が出てしまいました。
48
+
49
+ どうなおせばよいか、アドバイスいただければ幸いです。
50
+
51
+ よろしくお願いいたします。
52
+
53
+
54
+
55
+ --------------------------------------------------------
16
56
 
17
57
  全体のソースコード
18
58
 
@@ -165,47 +205,3 @@
165
205
 
166
206
 
167
207
  End Sub
168
-
169
-
170
-
171
-
172
-
173
- 試したこと
174
-
175
- ペーストされる空白セルの指定法が間違っていると思い。
176
-
177
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
178
-
179
- を
180
-
181
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
182
-
183
- や
184
-
185
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
186
-
187
- や
188
-
189
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
190
-
191
- や
192
-
193
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
194
-
195
- にしてみましたが、うまく実行されませんでした。
196
-
197
-
198
-
199
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
200
-
201
- としたところ、
202
-
203
- エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
204
-
205
- が出てしまいました。
206
-
207
-
208
-
209
- どうなおせばよいか、アドバイスいただければ幸いです。
210
-
211
- よろしくお願いいたします。

2

試したこと追加

2017/12/15 03:23

投稿

退会済みユーザー
test CHANGED
@@ -1 +1 @@
1
- 行が下に一列ずれてペーストされてしまう
1
+ 行が下に一列ずれてペーストされてしまう　エラー1004
test CHANGED
@@ -196,6 +196,16 @@
196
196
 
197
197
 
198
198
 
199
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
200
+
201
+ としたところ、
202
+
203
+ エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
204
+
205
+ が出てしまいました。
206
+
207
+
208
+
199
209
  どうなおせばよいか、アドバイスいただければ幸いです。
200
210
 
201
211
  よろしくお願いいたします。

1

試したことを追加しました

2017/12/15 03:21

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -30,7 +30,7 @@
30
30
 
31
31
  If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then
32
32
 
33
- Stop '転記先と転記元が同じブック
33
+ Stop
34
34
 
35
35
  Exit Sub
36
36
 
@@ -134,185 +134,21 @@
134
134
 
135
135
 
136
136
 
137
- '項目１'を開いている転記元からコピーして転記先にペースト
138
-
139
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(1)
140
-
141
-
142
-
143
- Dim koumoku1Cell As Excel.Range
144
-
145
- Set koumoku1Cell = copyWs.Range("A15:B15")
146
-
147
-
148
-
149
- koumoku1Cell.Copy
150
-
151
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
152
-
153
- Operation:=xlNone, _
154
-
155
- SkipBlanks:=False, _
156
-
157
- Transpose:=False
158
-
159
137
 
160
138
 
161
-
162
-
163
- 'サイズ1'を開いている転記元からコピーして転記先にペースト
164
-
165
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "E").End(xlUp).Offset(1)
166
-
167
-
168
-
169
- Dim size1Cell As Excel.Range
170
-
171
- Set size1Cell = copyWs.Range("A16:B16")
172
-
173
-
174
-
175
- size1Cell.Copy
176
-
177
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
178
-
179
- Operation:=xlNone, _
180
-
181
- SkipBlanks:=False, _
182
-
183
- Transpose:=False
184
-
185
-
186
-
187
- '用紙1'を開いている転記元からコピーして転記先にペースト
188
-
189
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "F").End(xlUp).Offset(1)
190
-
191
-
192
-
193
- Dim yousi1Cell As Excel.Range
194
-
195
- Set yousi1Cell = copyWs.Range("A17:B17")
196
-
197
-
198
-
199
- yousi1Cell.Copy
200
-
201
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
202
-
203
- Operation:=xlNone, _
204
-
205
- SkipBlanks:=False, _
206
-
207
- Transpose:=False
208
-
209
-
210
-
211
- '印刷1'を開いている転記元からコピーして転記先にペースト
212
-
213
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "G").End(xlUp).Offset(1)
214
-
215
-
216
-
217
- Dim insatsu1Cell As Excel.Range
218
-
219
- Set insatsu1Cell = copyWs.Range("A18:B18")
220
-
221
-
222
-
223
- insatsu1Cell.Copy
139
+ (途中同じようなコードなので省略）
224
-
225
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
140
+
226
-
227
- Operation:=xlNone, _
141
+
228
-
229
- SkipBlanks:=False, _
142
+
230
-
231
- Transpose:=False
232
-
233
-
234
-
235
- '内訳1'を開いている転記元からコピーして転記先にペースト
236
-
237
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "H").End(xlUp).Offset(1)
238
-
239
-
240
-
241
- Dim uchiwake1Cell As Excel.Range
242
-
243
- Set uchiwake1Cell = copyWs.Range("A27:B27")
244
-
245
-
246
-
247
- uchiwake1Cell.Copy
248
-
249
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
250
-
251
- Operation:=xlNone, _
252
-
253
- SkipBlanks:=False, _
254
-
255
- Transpose:=False
256
-
257
-
258
-
259
- '数量1'を開いている転記元からコピーして転記先にペースト
260
-
261
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
262
-
263
-
264
-
265
- Dim suryo1Cell As Excel.Range
266
-
267
- Set suryo1Cell = copyWs.Range("C27")
268
-
269
-
270
-
271
- suryo1Cell.Copy
272
-
273
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
274
-
275
- Operation:=xlNone, _
276
-
277
- SkipBlanks:=False, _
278
-
279
- Transpose:=False
280
-
281
-
282
-
283
- '単価1'を開いている転記元からコピーして転記先にペースト
284
-
285
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "J").End(xlUp).Offset(1)
286
-
287
-
288
-
289
- Dim tanka1Cell As Excel.Range
290
-
291
- Set tanka1Cell = copyWs.Range("D27")
292
-
293
-
294
-
295
- tanka1Cell.Copy
296
-
297
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
298
-
299
- Operation:=xlNone, _
300
-
301
- SkipBlanks:=False, _
302
-
303
- Transpose:=False
304
-
305
-
306
-
307
- '金額1'を開いている転記元からコピーして転記先にペースト
143
+ '金額2'を開いている転記元からコピーして転記先にペースト
308
144
 
309
145
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "K").End(xlUp).Offset(1)
310
146
 
311
147
 
312
148
 
313
- Dim kingaku1Cell As Excel.Range
149
+ Dim kingaku2Cell As Excel.Range
314
-
150
+
315
- Set kingaku1Cell = copyWs.Range("G27:H27")
151
+ Set kingaku2Cell = copyWs.Range("G28:H28")
316
152
 
317
153
 
318
154
 
@@ -328,38 +164,6 @@
328
164
 
329
165
 
330
166
 
331
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)
332
-
333
-
334
-
335
- (途中同じようなコードなので省略）
336
-
337
-
338
-
339
- '金額2'を開いている転記元からコピーして転記先にペースト
340
-
341
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "K").End(xlUp).Offset(1)
342
-
343
-
344
-
345
- Dim kingaku2Cell As Excel.Range
346
-
347
- Set kingaku2Cell = copyWs.Range("G28:H28")
348
-
349
-
350
-
351
- kingaku1Cell.Copy
352
-
353
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
354
-
355
- Operation:=xlNone, _
356
-
357
- SkipBlanks:=False, _
358
-
359
- Transpose:=False
360
-
361
-
362
-
363
167
  End Sub
364
168
 
365
169
 
@@ -380,6 +184,14 @@
380
184
 
381
185
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
382
186
 
187
+ や
188
+
189
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
190
+
191
+ や
192
+
193
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
194
+
383
195
  にしてみましたが、うまく実行されませんでした。
384
196
 
385
197