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

Question

前提・実現したいこと
次のイメージのようなエクセルで作った複数の見積書を、マクロでコピペして転記先のエクセルシートに一枚に情報をまとめるためのマクロを作成したいと考えています。

マクロを実行すると以下のようになり、イエローハイライトしている2行目3行目のように同じ行にコピーされるようにしたいのですが、一行ずつ（4～14行目のように）ずれてペーストされていってしまいます。

試したこと
ペーストされる空白セルの指定法が間違っていると思い。
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()

'前提条件
'- 転記元のシートを前面に表示していること
'- 転記先のシートがこのマクロが書かれいるブックであること

If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then
    Stop 
    Exit Sub
End If '

'転記元のシートを取得
    'Excelで今アクティブなシート
Dim copyWs As Excel.Worksheet
Set copyWs = Excel.ActiveWorkbook.ActiveSheet

'転記先のシートを取得
    'マクロが書かれているブックの、アクティブなシート
Dim pasteWs As Excel.Worksheet
Set pasteWs = Excel.ThisWorkbook.ActiveSheet

'入力する空白セルの指定
Dim pasteCell As Excel.Range
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)

'見積日を開いている転記元からコピーして転記先にペースト
Dim mitumoribiCell As Excel.Range
Set mitumoribiCell = copyWs.Range("A1:H1")

mitumoribiCell.Copy
pasteCell.PasteSpecial Paste:=xlPasteValues, _
                       Operation:=xlNone, _
                       SkipBlanks:=False, _
                       Transpose:=False

'品名'を開いている転記元からコピーして転記先にペースト
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlUp).Offset(1)

Dim hinmeiCell As Excel.Range
Set hinmeiCell = copyWs.Range("B12")

hinmeiCell.Copy
pasteCell.PasteSpecial Paste:=xlPasteValues, _
                       Operation:=xlNone, _
                       SkipBlanks:=False, _
                       Transpose:=False

'見積金額'を開いている転記元からコピーして転記先にペースト
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "C").End(xlUp).Offset(1)

Dim mitsumorikingakuCell As Excel.Range
Set mitsumorikingakuCell = copyWs.Range("E12:H12")

mitsumorikingakuCell.Copy
pasteCell.PasteSpecial Paste:=xlPasteValues, _
                       Operation:=xlNone, _
                       SkipBlanks:=False, _
                       Transpose:=False

(途中同じようなコードなので省略）

'金額2'を開いている転記元からコピーして転記先にペースト
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "K").End(xlUp).Offset(1)

Dim kingaku2Cell As Excel.Range
Set kingaku2Cell = copyWs.Range("G28:H28")

kingaku1Cell.Copy
pasteCell.PasteSpecial Paste:=xlPasteValues, _
                       Operation:=xlNone, _
                       SkipBlanks:=False, _
                       Transpose:=False

End Sub

Answer 1

Offsetとは

まずoffsetは、指定したセルから行方向、列方向にそれぞれ指定した数だけずらしたセルを返してくれるものです。
この時、第１引数は行方向（下方向）への移動数、第２引数は列方向（右方向）への移動数となります。
なお第２引数は完全省略が可能です。
たとえば
Cells("A1").Offset(1)　　⇒　A2セル
Cells("A1").Offset(1,1)　⇒　B2セル
Cells("A1").Offset(,1) 　⇒　B1セル
Cells("B2").Offset(-1,-1)⇒　A1セル
といった具合にセルを返します。

エラーの原因

では、エラーとなったコードを見てみましょう。
Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlToLeft).Offset(1)を分解すると、まずpasteWs.Cells(pasteWs.Rows.Count, "B")という部分があります。

Rows.Countは使用しているExcelのバージョンで利用できる最大の行番号を返します。
つまりpasteWs.Cells(pasteWs.Rows.Count, "B")はB列の最大行のセルを指します。

次に、そのセルに対して.End(xlToLeft)をしています。
これはシート上の操作で「Ctrl」と「←」を同時押しした操作になり、指定セルより左方向にむかって、連続データの区切り目を探す動きをします。
今参照しているセルが空欄なら、そのセルから左方向に探していって初めてデータが入力されているセルを指すことになります。
逆に今参照しているセルが値の入力されているセルなら、そのセルから左方向に探していって初めて空欄が入力されているセルを指します。
ずっと空欄やデータ入力セルが続いていた場合は、A列を返すことになります。

ちなみに.End(xlUp)は同じように上方向に向かって探して最初に見つけた区切り目のセルを返します。
（「Ctrl」と「↑」の動き。）

ここではB列に対してこの操作をしていますので、B列最大行のセルにデータがあろうとなかろうと、A列最大行のセルを指すことになると思います。

さて、そうして見つけたセルに対してさらにOffset(1)したセルを参照しています。
しかし、ここまでの解説のとおり、この時点で参照しているセルはA列最終行のセルです。
そこからさらにOffsetで１行下のセルを参照しようとしているため、エラーが発生しているものと思います。

出力位置がズレる現象について

これについてはA列セルへのペーストと、B列セルへのペーストでズレる部分がわかりやすいので、ここで解説します。
説明をわかりやすくするため、シートには各列20行目までデータが入力されているものとします。

まずA列セルへのペーストをみてみると、
コピー元セル：copyWs.Range("A1:H1")
コピー先セル：pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)
となっています。
コピー先セルは先ほど説明したものとほぼ同じです。
pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp)でA列で最後にデータが入力されているセル(A20セル)を参照し、そこからOffset(1)でひとつ下のセル(A21セル)を参照しています。
つまり、A列の最終データ行の下の空白行（＝新規データの貼り付け位置）というわけです。
※A列の最大行まですべてデータが埋まっている場合この限りではないのですが、それを想定したコードではないのでここでは無視します。

こうして見つけたA21セルに、コピー元であるA1:H1の内容を貼り付けます。
結果、A21:H21セルにA1:H1と同じ内容が入力されます。

次にB列セルへのペーストをみてみると、
コピー元セル：copyWs.Range("B12")
コピー先セル：pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlUp).Offset(1)
となっています。

途中はハショりますが、この時点でB列はB21までデータが入力されていますので、コピー先セルはB列で最後にデータが入力されているセル(B21セル)の１つ下のセル(B22)となります。
こうしてB22セルにB12セルの内容が貼り付きました。
この時A22セルには何も入力されていないので、これがズレとなっています。

～　その後の貼り付けは　～
B列では1セルしか貼り付けていないため、この時点でC22も空欄です。
なのでC列の貼り付け時にはC22セルにデータが貼り付けられます。
C列に貼り付ける内容はE12:H12ですので、C22:F22にデータが入力されます。
その後D列にも同じようにデータを貼り付けるとしたら、D23セルに貼り付けられることになると思います。

こうしてズレていくという訳です。

対応

コピー元が連結セルとなっている項目について、連結範囲全体をコピー元セルとしているところに問題がありそうです。
連結セルの値は連結範囲の左上セルに格納されていますので、例えばA列に貼り付ける見積もり日のコピー元はcopyWs.Range("A1:H1")ではなくcopyWs.Range("A1")とすればA列への貼り付けでB列いんまでデータが入力されることがなくなり、期待する動作になるのではないかと思います。

また、現在の処理では各列の貼り付け位置を毎回Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)のように取得しなおしています。
もしB列以降の貼り付けも、A列で見積日を貼り付けた行と同じ行に出力するのでよいのなら、毎回最終行を探す必要もないと思います。
A列への貼り付け行を見つけたら行番号を覚えておき、B列以降の貼り付け先も同じ行番号でセルを指定するという方法です。

Dim iPasteRow As INteger
iPasteRow = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1).Row
Set pasteCell = pasteWs.Cells(iPasteRow, "A")
・・・
Set pasteCell = pasteWs.Cells(iPasteRow, "B")

参考になれば幸いです。

Comments

[退会済みユーザー]

早速に、かみくだいてとてもご丁寧なご解説、誠にありがとうございます！
自分でいじって、なぜoffsetの中を変えて動いたのか、そしてコードの意味がやっとクリアに理解できました！！
また、もうひと工夫できるアドバイスまでいただき、誠にありがとうございます！
試してみたいと思います。
みなさま大変ありがとうございました！！

Answer 2

実際に動かしてみてはいないので、ソースを見て 多分こうなんじゃないかな という程度なのですが…

---

まず A 列は正しくできていますよね。

Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1)

これは、
pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp) でまず最終行（3行目）に移動し、
.Offset(1) で一行下げているのだと思います。

その次に B 列で同じことをしていますが、

Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlUp).Offset(1)

A 列で 4 行目が作成されているので
pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlUp) で最終行（4行目）に移動し、
.Offset(1) で一行下がっている･･･
という感じで順番に一行ずつ下がっていっているのではないかなと思います。

軽く検索したところ
.Offset(1) で一行下げ、
.Offset(0) で同行、
.Offset(0, 1) で同行 1 セル右に移動
みたいなのでその辺でうまくできないかなと思いますが･･･

---

ただ、私だったら

• A列をコピーする前に まず最終行の行番号を取得
• 以降は、「最終行に移動して +1 行」とかではなく最初に取った行番号でこちゃこちゃする

の方が良いかなあと思います。（ロジック的に）

（全然 試してないですけど。多分できますよね･･･？）

Answer 3

直接の回答ではないですが、コードを改良すべく、
関数(Function , Sub)を作れませんか？

ここだと、コピペ用の関数、最終行を取得する関数、
を汎用的な形（他でも流用できるように）で作っておくと、
コードが読みやすくなり、
処理も安定し、
メンテナンスもしやすくなります。

Answer 4

Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "I").End(xlUp).Offset(0,0)
としたところ解決しました！
が、エラーの意味と、なぜ解決したのか、明快に理解がよくできません。
もしご解説どなたかいただけたらとてもうれしいです。
よろしくお願いいたします。