編集履歴

質問編集履歴

試したこと追記

2017/12/15 03:23

投稿

退会済みユーザー

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -5,7 +5,27 @@
 マクロを実行すると以下のようになり、イエローハイライトしている2行目3行目のように同じ行にコピーされるようにしたいのですが、一行ずつ（4～14行目のように）ずれてペーストされていってしまいます。
 ![イメージ説明](6c43c274890feee86d3fce85f8210dd2.png)
+試したこと
+ペーストされる空白セルの指定法が間違っていると思い。
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
+を
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
+や
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
+や
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
+や
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
+にしてみましたが、うまく実行されませんでした。
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
+としたところ、
+エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
+が出てしまいました。
+どうなおせばよいか、アドバイスいただければ幸いです。
+よろしくお願いいたします。
+--------------------------------------------------------
 全体のソースコード
 Sub Macro1()
@@ -81,26 +101,4 @@
                            SkipBlanks:=False, _
                            Transpose:=False
-End Sub
+End Sub
-試したこと
-ペーストされる空白セルの指定法が間違っていると思い。
-Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
-を
-Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
-や
-Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
-や
-Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
-や
-Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
-にしてみましたが、うまく実行されませんでした。
-Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
-としたところ、
-エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
-が出てしまいました。
-どうなおせばよいか、アドバイスいただければ幸いです。
-よろしくお願いいたします。

試したこと追加

2017/12/15 03:23

投稿

退会済みユーザー

スコア0

title CHANGED Viewed

	@@ -1,1 +1,1 @@
1	- 行が下に一列ずれてペーストされてしまう
1	+ 行が下に一列ずれてペーストされてしまう　エラー1004

body CHANGED Viewed

@@ -97,5 +97,10 @@
 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
 にしてみましたが、うまく実行されませんでした。
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)
+としたところ、
+エラー1004：アプリケーション定義またはオブジェクト定義のエラーです。
+が出てしまいました。
 どうなおせばよいか、アドバイスいただければ幸いです。
 よろしくお願いいたします。

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

2017/12/15 03:21

投稿

退会済みユーザー

スコア0

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -14,7 +14,7 @@
     '- 転記先のシートがこのマクロが書かれいるブックであること
     If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then
-        Stop '転記先と転記元が同じブック
+        Stop
         Exit Sub
     End If '
@@ -66,105 +66,7 @@
                            SkipBlanks:=False, _
                            Transpose:=False
-    '項目１'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(1)
-    Dim koumoku1Cell As Excel.Range
-    Set koumoku1Cell = copyWs.Range("A15:B15")
-    koumoku1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    'サイズ1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "E").End(xlUp).Offset(1)
-    Dim size1Cell As Excel.Range
-    Set size1Cell = copyWs.Range("A16:B16")
-    size1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    '用紙1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "F").End(xlUp).Offset(1)
-    Dim yousi1Cell As Excel.Range
-    Set yousi1Cell = copyWs.Range("A17:B17")
-    yousi1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    '印刷1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "G").End(xlUp).Offset(1)
-    Dim insatsu1Cell As Excel.Range
-    Set insatsu1Cell = copyWs.Range("A18:B18")
-    insatsu1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    '内訳1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "H").End(xlUp).Offset(1)
-    Dim uchiwake1Cell As Excel.Range
-    Set uchiwake1Cell = copyWs.Range("A27:B27")
-    uchiwake1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    '数量1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(1)
-    Dim suryo1Cell As Excel.Range
-    Set suryo1Cell = copyWs.Range("C27")
-    suryo1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    '単価1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "J").End(xlUp).Offset(1)
-    Dim tanka1Cell As Excel.Range
-    Set tanka1Cell = copyWs.Range("D27")
-    tanka1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    '金額1'を開いている転記元からコピーして転記先にペースト
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "K").End(xlUp).Offset(1)
-    Dim kingaku1Cell As Excel.Range
-    Set kingaku1Cell = copyWs.Range("G27:H27")
-    kingaku1Cell.Copy
-    pasteCell.PasteSpecial Paste:=xlPasteValues, _
-                           Operation:=xlNone, _
-                           SkipBlanks:=False, _
-                           Transpose:=False
-    Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)
    (途中同じようなコードなので省略）
     '金額2'を開いている転記元からコピーして転記先にペースト
@@ -189,6 +91,10 @@
 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(-1)
 や
 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).
+や
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToRight).Offset(1)
+や
+Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count-1, "I").End(xlUp).Offset(1)
 にしてみましたが、うまく実行されませんでした。
 どうなおせばよいか、アドバイスいただければ幸いです。