VBAで貼り付けが2回目以降うまくできないことについて

A1〜A10に1から10までの数字を入力してあるのを別のエクセルファイルの１つのセルに貼り付けしたい。

ただ、1から10までの数字は仮で都度入る値は変わるため、単に改行コードを入れて貼り付けしただけでは、やりたいこととしては違うと考えています。
そこで、メモ帳に貼り付けし、先頭と末尾に「"」を入れそれをコピーして入力したいエクセルファイルに貼り付けしようと考えました。
また、入力先のセルも毎回同じところではなく、B列の一番最初の空白部分に貼り付けたいため、SpecialCellsを用いる方法を調べました。

コードは以下の通りなのですが、これは1回目だとうまくいきます。ですが、続けて実行すると、10個のセルに1から10までの数字が一つずつ入ってしまいます。（１つのセルに改行されて入らず、複数のセルに分かれて値が入ってしまいます。）
一度、入力先のファイルを保存して終了しないと実行できないようなのですが、解決策、原因等教えていただきたいです。

コード

Sub test()

Range("A1:A10").Copy
Shell "Notepad.Exe", vbNormalFocus
Sendkeys "^v"
Sendkeys "{BACKSPACE}"""
Sendkeys "^a"
Sendkeys "^c"
Workbooks.Open ("C:¥test.xlsx")
Range("B1:B10").SpecialCells(XlCellTypeBlanks).Item(1).Select
Selection.Paste

End Sub

行動規範の内容に同意します

回答1件

ベストアンサー

やりたいことが、
A1〜A10の値を改行で連結して、前後に"(引用符)を付加して、
別ブックの一つのセルに入力する。
ということなら、下記でどうでしょう。

vba
1Sub test()
2    Dim s As String
3    s = Join(WorksheetFunction.Transpose(Worksheets("Sheet1").Range("A1:A10").Value), vbLf)
4 
5    Dim wb As Workbook
6    Set wb = Workbooks.Open ("C:\test.xlsx")
7    On Error Resume Next
8    wb.WorkSheets(1).Range("B1:B10").SpecialCells(xlCellTypeBlanks).Item(1).Value = """" & s & """"
9    If Err <> 0 Then MsgBox "出力先に空白セルはありません。"
10End Sub