【Excel】選択したセルを別シートの空白行の指定列に貼り付け

Question

お世話になります。
下記のシートのB2～D2をコピーし別シートの空白行のD列に貼り付けたいのですがどのようなVBAにすれば良いのでしょうか。
下記コードを実行するとD列ではなくA列に貼り付けになってしまいます。

品番	品名	金額	数量	合計
1090	えんぴつ	500円	2個	1000円

'
' Macro1 Macro
'

'
    Range("B2:D2").Select
    Selection.Copy
    Workbooks.Open Filename:= _
        "C:\Users\tkyks\Desktop\data.xlsx"
    n = Cells(Rows.Count, "D").End(xlUp).Row + 1
    ActiveSheet.Paste
    ActiveWindow.ActivateNext
End Sub

よろしくお願い申し上げます。

Answer 1

こんな感じでどうでしょうか。（修正しました）

    Dim moto As Worksheet, saki As Worksheet
    Set moto = ThisWorkbook.Worksheets(1)
    Set saki = Workbooks.Open("C:\Users\tkyks\Desktop\data.xlsx").Worksheets(1)
    
    Dim n
    n = saki.Cells(saki.Rows.Count, "D").End(xlUp).Row + 1
    
    moto.Range("B2:D2").Copy saki.Cells(n, "D")

Comments

[tkyk.]

jinojiさん

ありがとうございます。
教えていただいたVBA試してみましたが上手く行きませんでした。
別シートは開くのですがコピーと貼り付けが出来ません。
すみません。再度教えていただくことは可能でしょうか。
よろしくお願いします。

[jinoji]

元と先が逆かも。

[jinoji]

"C:\Users\tkyks\Desktop\data.xlsx" が貼り付け先ですか？

[tkyk.]

jinojiさん

ありがとうございます。
"C:\Users\tkyks\Desktop\data.xlsx" こちらが貼り付け先となります。

[jinoji]

すみません。勘違いしていました。
修正してみましたがどうでしょうか。

[tkyk.]

jinojiさん

ありがとうございます！
上手く出来ました！
ちなみに("B2:D2")を「選択したセル」にする場合にはどのように書き換えれば良いのでしょうか。
初歩的な質問かと思いますが、宜しくお願い致します。

[tkyk.]

jinojiさん
度々申し訳ございません。
それと教えていただいたコードですが、続けて貼り付けしようとすると次の行ではなく同じ行に貼り付けになってしまいます。
毎回、空白行のD列に貼り付けするのはどのようにすれば良いのでしょうか。
重ねての質問すみません。

[jinoji]

その時選択しているセル範囲、ということなら、
処理の最初で、
Dim motoCell As Range
Set motoCell = ActiveWindow.RangeSelection
みたいにする方法があります。

ダイアログを出して選択させるなら、
以下のような処理を用意して、それを呼び出すのがよいでしょう。
Function CellSelect() As Range
On Error GoTo ER
Set CellSelect = Application.InputBox("", "セル範囲を指定", , , , , , 8)
Exit Function
ER:
Set CellSelect = ActiveWindow.RangeSelection
End Function

[jinoji]

続けて貼り付け というのをどういうコードでやろうとしているのかによりますが、
n = saki.Cells(saki.Rows.Count, "D").End(xlUp).Row + 1
が空白行を取得する部分なので、都度それをすればいいと思います。

[tkyk.]

jinojiさん
Dim motoCell As Range
Set motoCell = ActiveWindow.RangeSelection
は処理の最初とのことですが、具体的にどの部分に入れれば良いのでしょうか。
初歩的な質問で本当にすみません。

[jinoji]

Dim motoCell As Range
Set motoCell = ActiveWindow.RangeSelection

Dim saki As Worksheet
Set saki = Workbooks.Open("C:\Users\tkyks\Desktop\data.xlsx").Worksheets(1)
Dim n
n = saki.Cells(saki.Rows.Count, "D").End(xlUp).Row + 1

motoCell.Copy saki.Cells(n, "D")

[tkyk.]

jinojiさん

ありがとうございます！
教えていただいたコードで無事に思い通りのマクロに出来ました。
お手数おかけしすみませんでした。
大変助かりました！！