質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

91.24%

  • VBA

    1183questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1016questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

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

解決済

回答 4

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 146

vbabeginner

score 13

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

マクロを実行すると以下のようになり、イエローハイライトしている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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 4

checkベストアンサー

+4

Offsetとは

まずoffsetは、指定したセルから行方向、列方向にそれぞれ指定した数だけずらしたセルを返してくれるものです。
この時、第1引数は行方向(下方向)への移動数、第2引数は列方向(右方向)への移動数となります。
なお第2引数は完全省略が可能です。
たとえば
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で1行下のセルを参照しようとしているため、エラーが発生しているものと思います。

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

これについては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セル)の1つ下のセル(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")

参考になれば幸いです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/12/15 15:32

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

    キャンセル

+3

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


まず 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 行」とかではなく最初に取った行番号でこちゃこちゃする

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

(全然 試してないですけど。多分できますよね・・・?)

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

+1

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

ただいまの回答率

91.24%

関連した質問

同じタグがついた質問を見る

  • VBA

    1183questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1016questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。