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

編集履歴

質問編集履歴

3

試したこと追記

2017/12/15 03:23

投稿

退会済みユーザー
title CHANGED
File without changes
body CHANGED
@@ -5,7 +5,27 @@
5
5
  マクロを実行すると以下のようになり、イエローハイライトしている2行目3行目のように同じ行にコピーされるようにしたいのですが、一行ずつ（4～14行目のように）ずれてペーストされていってしまいます。
6
6
  ![イメージ説明](6c43c274890feee86d3fce85f8210dd2.png)
7
7
 
8
+ 試したこと
9
+ ペーストされる空白セルの指定法が間違っていると思い。
10
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
11
+ を
12
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
13
+ や
14
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
15
+ や
16
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
17
+ や
18
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
19
+ にしてみましたが、うまく実行されませんでした。
8
20
 
21
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
22
+ としたところ、
23
+ エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
24
+ が出てしまいました。
25
+ どうなおせばよいか、アドバイスいただければ幸いです。
26
+ よろしくお願いいたします。
27
+
28
+ --------------------------------------------------------
9
29
  全体のソースコード
10
30
  Sub Macro1()
11
31
 
@@ -81,26 +101,4 @@
81
101
  SkipBlanks:=False, _
82
102
  Transpose:=False
83
103
 
84
- End Sub
104
+ End Sub
85
-
86
-
87
- 試したこと
88
- ペーストされる空白セルの指定法が間違っていると思い。
89
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
90
- を
91
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
92
- や
93
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
94
- や
95
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
96
- や
97
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
98
- にしてみましたが、うまく実行されませんでした。
99
-
100
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
101
- としたところ、
102
- エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
103
- が出てしまいました。
104
-
105
- どうなおせばよいか、アドバイスいただければ幸いです。
106
- よろしくお願いいたします。

2

試したこと追加

2017/12/15 03:23

投稿

退会済みユーザー
title CHANGED
@@ -1,1 +1,1 @@
1
- 行が下に一列ずれてペーストされてしまう
1
+ 行が下に一列ずれてペーストされてしまう　エラー1004
body CHANGED
@@ -97,5 +97,10 @@
97
97
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
98
98
  にしてみましたが、うまく実行されませんでした。
99
99
 
100
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
101
+ としたところ、
102
+ エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
103
+ が出てしまいました。
104
+
100
105
  どうなおせばよいか、アドバイスいただければ幸いです。
101
106
  よろしくお願いいたします。

1

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

2017/12/15 03:21

投稿

退会済みユーザー
title CHANGED
File without changes
body CHANGED
@@ -14,7 +14,7 @@
14
14
  '- 転記先のシートがこのマクロが書かれいるブックであること
15
15
 
16
16
  If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then
17
- Stop '転記先と転記元が同じブック
17
+ Stop
18
18
  Exit Sub
19
19
  End If '
20
20
 
@@ -66,105 +66,7 @@
66
66
  SkipBlanks:=False, _
67
67
  Transpose:=False
68
68
 
69
- '項目１'を開いている転記元からコピーして転記先にペースト
70
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(1)
71
-
72
- Dim koumoku1Cell As Excel.Range
73
- Set koumoku1Cell = copyWs.Range("A15:B15")
74
-
75
- koumoku1Cell.Copy
76
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
77
- Operation:=xlNone, _
78
- SkipBlanks:=False, _
79
- Transpose:=False
80
69
 
81
-
82
- 'サイズ1'を開いている転記元からコピーして転記先にペースト
83
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "E").End(xlUp).Offset(1)
84
-
85
- Dim size1Cell As Excel.Range
86
- Set size1Cell = copyWs.Range("A16:B16")
87
-
88
- size1Cell.Copy
89
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
90
- Operation:=xlNone, _
91
- SkipBlanks:=False, _
92
- Transpose:=False
93
-
94
- '用紙1'を開いている転記元からコピーして転記先にペースト
95
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "F").End(xlUp).Offset(1)
96
-
97
- Dim yousi1Cell As Excel.Range
98
- Set yousi1Cell = copyWs.Range("A17:B17")
99
-
100
- yousi1Cell.Copy
101
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
102
- Operation:=xlNone, _
103
- SkipBlanks:=False, _
104
- Transpose:=False
105
-
106
- '印刷1'を開いている転記元からコピーして転記先にペースト
107
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "G").End(xlUp).Offset(1)
108
-
109
- Dim insatsu1Cell As Excel.Range
110
- Set insatsu1Cell = copyWs.Range("A18:B18")
111
-
112
- insatsu1Cell.Copy
113
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
114
- Operation:=xlNone, _
115
- SkipBlanks:=False, _
116
- Transpose:=False
117
-
118
- '内訳1'を開いている転記元からコピーして転記先にペースト
119
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "H").End(xlUp).Offset(1)
120
-
121
- Dim uchiwake1Cell As Excel.Range
122
- Set uchiwake1Cell = copyWs.Range("A27:B27")
123
-
124
- uchiwake1Cell.Copy
125
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
126
- Operation:=xlNone, _
127
- SkipBlanks:=False, _
128
- Transpose:=False
129
-
130
- '数量1'を開いている転記元からコピーして転記先にペースト
131
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
132
-
133
- Dim suryo1Cell As Excel.Range
134
- Set suryo1Cell = copyWs.Range("C27")
135
-
136
- suryo1Cell.Copy
137
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
138
- Operation:=xlNone, _
139
- SkipBlanks:=False, _
140
- Transpose:=False
141
-
142
- '単価1'を開いている転記元からコピーして転記先にペースト
143
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "J").End(xlUp).Offset(1)
144
-
145
- Dim tanka1Cell As Excel.Range
146
- Set tanka1Cell = copyWs.Range("D27")
147
-
148
- tanka1Cell.Copy
149
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
150
- Operation:=xlNone, _
151
- SkipBlanks:=False, _
152
- Transpose:=False
153
-
154
- '金額1'を開いている転記元からコピーして転記先にペースト
155
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "K").End(xlUp).Offset(1)
156
-
157
- Dim kingaku1Cell As Excel.Range
158
- Set kingaku1Cell = copyWs.Range("G27:H27")
159
-
160
- kingaku1Cell.Copy
161
- pasteCell.PasteSpecial Paste:=xlPasteValues, _
162
- Operation:=xlNone, _
163
- SkipBlanks:=False, _
164
- Transpose:=False
165
-
166
- Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)
167
-
168
70
  (途中同じようなコードなので省略）
169
71
 
170
72
  '金額2'を開いている転記元からコピーして転記先にペースト
@@ -189,6 +91,10 @@
189
91
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
190
92
  や
191
93
  Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
94
+ や
95
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
96
+ や
97
+ Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
192
98
  にしてみましたが、うまく実行されませんでした。
193
99
 
194
100
  どうなおせばよいか、アドバイスいただければ幸いです。