VBA 別シートの最終行に追記

質問

ExcelのSheet1で作成した表の一部項目を、Sheet2に一覧表としてまとめたいのです。

例えばSheet1にアンケート項目のような入力されていて、毎日使いまわします。
セルA1：　訪問日→固定　　　　　セルB1：　（日付）→更新
セルA3：　お客様指名→固定　　セルB3：　（氏名）→更新
使いまわすので、1度入力されたものは、Sheet2に一覧表として転記しておきたいのです。Sheet2の一覧表の最終行をみつけて追記していきたいです。
書いてみたのは以下の通り。

Private Sub 登録ボタン_Click()

Dim SH1 As Worksheet, SH2 As Worksheet
Dim GYO As Long

Set SH1 = ThisWorkbook.Worksheets("回答内容")
Set SH2 = ThisWorkbook.Worksheets("情報シート")

' Sheet2の最終行を取得
GYO = SH2.Range("$A$65536").End(xlUp).Row
' 最終行の次行を取得
If SH2.Cells(GYO, 1).Value <> "" Then GYO = GYO + 1
　' 現在の収容位置の下に転記
SH2.Cells(GYO, 1).Resize(1, 20).Value = SH1.Range("$c$2:$D$10").Value

With SH1
.Range("A3").Copy Destination:=SH2.Range("A2")
.Range("B3").Copy Destination:=SH2.Range("B2")
End With
End Sub

項目は飛び飛びのセルに入力されていて、それらをまとめて一覧表の1行にまとめたいと思っています。
ここでは例としてSheet1[A3][B3]セルをSheet2へ転記していますが、項目はもっといっぱいあります。
記載したコードで実行すると、1回目は転記されますが、2回目以降が追記されていきません。
' 現在の収容位置の下に転記
のところに問題があると思っています。

全くの初心者が、コードを書くのには無理があると思いますが、どなたか教えていただけないでしょうか。宜しくお願いします。

回答No.2

DOUGLAS_

＞記載したコードで実行すると、1回目は転記されますが、2回目以降が追記されていきません。
　私は１回目もおかしいと存じますが。。。

＞' 現在の収容位置の下に転記
以下が、例えば

SH2.Cells(GYO, 3).Resize(1, 9).Value = Application.Transpose(SH1.Range("$c$2:$C$10").Value)
SH2.Cells(GYO, 12).Resize(1, 9).Value = Application.Transpose(SH1.Range("$D$2:$D$10").Value)
With SH1
.Range("A3:B3").Copy Destination:=SH2.Cells(GYO, 1).Resize(, 2)
End With

ということなら、何となく解りますが。。。

＞項目は飛び飛びのセルに入力されていて、それらをまとめて一覧表の1行にまとめたい
のでしたら、例えば、
＞' 現在の収容位置の下に転記
以下を

Dim myCells As Variant, i As Byte
myCells = Split("A3 B3 C2 C3 C4 C5 C6 C7 C8 C9 C10 D2 D3 D4 D5 D6 D7 D8 D9 D10")
For i = 0 To 19
SH2.Cells(GYO, i + 1).Value = SH1.Range(myCells(i)).Value
Next

のようにに変えてみられてはいかがでしょうか？

お礼

最終的には下記の記述で正常に動くようになりました！。
-------------------------------------------------------------
Private Sub 登録ボタン_Click()
　Dim SH1 As Worksheet, SH2 As Worksheet
　Dim GYO As Long
　Dim copydata()
Set SH1 = ThisWorkbook.Worksheets("回答内容")
Set SH2 = ThisWorkbook.Worksheets("情報シート")
' 転記先Sheet2の最終行を取得
GYO = SH2.Range("A65536").End(xlUp).Offset(1).Row
' 最終行の次行を取得
If SH2.Cells(GYO, 1).Value <> "" Then GYO = GYO + 1
　 ' 転記するデータを取得
　 copydata = SH1.Range("Z1").Resize(100, 1).Value
　 ' 現在の収容位置の下に転記（行列入替）
　 copydata = WorksheetFunction.Transpose(copydata)
　SH2.Cells(GYO, 1).Resize(1, 100).Value = copydata
End Sub
-------------------------------------------------------------

回答No.1

n-jun

＞ここでは例としてSheet1[A3][B3]セルをSheet2へ転記していますが、項目はもっといっぱいあります。
例題に対して回答をもらい応用できるのなら問題ないですけど、そうではなければ
初めから具体的に質問された方が宜しいかも。

＞SH2.Cells(GYO, 1).Resize(1, 20).Value = SH1.Range("$c$2:$D$10").Value
左辺と右辺でのセル範囲って違いますよね？

蛇足でしたらごめんなさい。

お礼

アドバイスありがとうございます。
左辺と右辺はご指摘の通り、違います。
「SH2.Cells(GYO, 1).Resize(1, 20).Value = SH1.Range("$c$2:$D$10").Value」
自分でもよくわからず書いてしまいましたが、やりたいことが、Sheet1の非連続セルのデータ（具体的にセルB1とB3のみ対象）を、Sheet2に一覧（1行）に転記したかったので。
書くとすれば、
＞SH2.Cells(GYO, 1).Resize(1, 20).Value = SH1.Range("$A$1:$B$3").Value
と書けたかもしれませんが、これだとRangeの後に書いたセルのデータが、B1の同じデータのみ横に20列も入力されてしまいました。