Excel VBA : 追加でコピペする方法

質問

ExcelのVBAでマクロを作成したので教えて下さい。

sheet(1)C3からC列にDATAが入力済みです。
（同じく、D3からD列にもC列と同じ行数DATAが入力済みです。）

DATAは、途中で空白セルは無く、全て埋められた状態です。
（つまり、C列とD列の使用されている行数は全く同じです。）

それぞれのDATA（C列、D列）をコピーして
Sheet(2)のB3（B列）とC3（C列）から下方にペーストするのですが、
Sheet(2)のB列とC列には既に旧DATAが入力済みなので
旧DATAは消去せず下側に追加する形式でコピペしたいのです。
（旧DATAの直下の行に新規にDATAを追加）

利用済みの行数を取得してコピーは下記で良さそうですが　？
　　Cells(3,3).end(xlDown).Row.copy

書き込み（ペース）で思考が停止状態です。

どのようにすれば良いでしょうか　？

回答No.5

kkkkkm · ベストアンサー

No4の追加です、
最初の
Dim Sh1 As Worksheet, Sh2 As Worksheet
が抜けてました。

また、B列には書式もコピーし、C列には値だけでしたら以下のようにしてください。
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")

Sh1.Range(Sh1.Cells(3, "C"), Sh1.Cells(Rows.Count, "C").End(xlUp)).Copy
Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial
Sh1.Range(Sh1.Cells(3, "D"), Sh1.Cells(Rows.Count, "D").End(xlUp)).Copy
Sh2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
Set Sh1 = Nothing
Set Sh2 = Nothing

お礼

ありがとうございます。

値のみのコピペが完了しました。

おかげさまで解決しました。

回答No.4

kkkkkm

> 　値のみペーストするようにしたいです。

以下のように変更してください。CopyとPasteが別の行になっています。すべて値のみです。

Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")

Sh1.Range(Sh1.Cells(3, "C"), Sh1.Cells(Rows.Count, "D").End(xlUp)).Copy
Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Set Sh1 = Nothing
Set Sh2 = Nothing

回答No.3

masnoske

Dim src As Range
Dim dest As Range
Set src = Range(Sheets(1).Cells(3, 3), Sheets(1).Cells(3, 4).End(xlDown))
Set dest = Sheets(2).Cells(3, 2).End(xlDown)
Set dest = Range(dest.Offset(1, 0), dest.Offset(src.Rows.Count, src.Columns.Count))
src.Copy
dest.PasteSpecial

でどうでしょうか。
値だけのコピーで良ければ、最後の２行を
dest.Value = src.Value

お礼

コードを教えて頂きありがとうございます。

おかげさまで何とか希望の処理ができそうです。

回答No.2

Mathmi

＞思考が停止状態です。
　プログラムの基礎ですが、まず「手作業で行うならばどう行うか」を考えます。
　そのプロセスを一つ一つ分解していけば、後はコードに翻訳するだけです。

＞下記で良さそうですが？
＞Cells(3,3).end(xlDown).Row.copy
　CopyはRangeオブジェクトのメソッドです。
　これでは、Rowで取得した数に対して行おうとしているのでエラーになります。

＞どのようにすれば良いでしょうか？
　自分がするなら、以下のようにします(データがなかった場合等、エラートラップがまだ足りませんが)。
・コピー先のシートでどこからコピーするかを検索。
　Sheet2!B:Cのデータに空白はないと考え、End(xlDown)で最終行を取得、その行+1に貼り付けるものとする。
・コピー元の範囲を取得。
　基準セルからEnd(xlDown)で最終行を取得したら、Resizeで対象範囲を取得。
・コピー元セル範囲をコピー先セルに貼り付け。

Sub test()
　Dim CopyBaseCell As Range 'コピーの基準になるセル。
　Dim PasteBaseCell As Range '貼り付けの基準になるセル。
　Dim LastRow As Long '最終行の行番号。
　Dim Target As Range 'コピーするセル範囲。

　Set CopyBaseCell = Worksheets("Sheet1").Cells(3, 3)
　Set PasteBaseCell = Worksheets("Sheet2").Cells(3, 2)

　'貼り付け先の基準セルを取得。
　LastRow = PasteBaseCell.End(xlDown).Row
　Set PasteBaseCell = PasteBaseCell.Parent.Cells(LastRow + 1, PasteBaseCell.Column)

　'コピー範囲を取得、貼り付け。
　LastRow = CopyBaseCell.End(xlDown).Row
　Set Target = CopyBaseCell.Resize(LastRow - CopyBaseCell.Row + 1, 2)
　Target.Copy PasteBaseCell
End Sub

お礼

回答有り難うございます。

昔、少しVBAを利用していただけで
　記憶は忘却の方向に進み、Officeも2019となり
　　まごつくことが多いのですがとても参考になります。

回答No.1

kkkkkm

Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
がSheet2のB列の最終行の一つ下のセルになります。
Sheet1のD列にもC列と同じ行数入っているので
Sheet1のC3からDの最終行までの範囲をSheet2のB列の最終行の次以降にコピーしたらいいですね

Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")

Sh1.Range(Sh1.Cells(3, "C"), Sh1.Cells(Rows.Count, "D").End(xlUp)).Copy _
Sh2.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
Set Sh1 = Nothing
Set Sh2 = Nothing

お礼

ありがとうございます。

コピペは思うように作動していまが、
　シート1のD列をコピーしてシート2のC列にペーストするのに
　値のみペーストするようにしたいです。

シート２のC列のセルは、内部を特定色で塗りつぶしているのですが
シート1のD列と指定色が違うのでコピー元の指定色でC列が塗りつぶされてしまいます。