Wクリックで転記

この質問の前に、複雑な質問をして回答が付きませんでした！
以前Wクリックで転記　最高の回答をいただきました。それをもとに挑戦をしてみましたが、何せ素人できるわけもなく、重ねての質問になります。

Sh2　コード票　　A2　B2　C2　D2　　2～1000行入っています
コード表のA2列のセルをWクリックして　Sh1　データの指定セルへ順次転記したいのですが

Sh2　（コード表）　　　　A列　　　　　D列　　　　E列　
　　　　　　　　　　　　　は　　　　　　は　　　　は
Sh1　（データ）　　　　　B列　　　　　F列　　　　G列

高齢と素人、解説も教えてもらえたらありがたく思います、ぜひお願いいたします。

質問者からの補足コメント

• ありがとうございます。早速やってみたのですがエラーは出ないのですが転記されません。
  素人には説明もうまくできていないと、感じています。
  申し訳ありませんが、単純にコード　A列をWクリックしたセルがデータB列に順次コピー転記できるように、ご指導お願いいたします。A列～B列だけでお願いします

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/04/15 21:48

• お手数おかけします。
  書き換えてみたのですが、反応はしてエラーも出ませんが、転記されていません。
  私のやっていることが悪いと思いますが、手順の説明を教えていただけるとありがたいのですが、混乱してると思います、すみません。

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/04/16 08:23

• 説明がうまくできなくてごめんなさい。
  NO2でよいと思います、コード表A列セルをWクリックするとデータB列へ順次転記でよいのですが、
  NO2のコードがそうであれば、反応はしますが転記されないエラーも出ません。
  申し訳ないのですが、もう一度ご指導お願いします。

  No.3の回答に寄せられた補足コメントです。 補足日時：2017/04/16 08:53

No.1 回答者： tom04 回答日時： 2017/04/15 21:04

こんばんは！

「コード表」シートのデータはA～D列にあるという説明文ですが、
「データ」シートに表示するのはA・D・E列になっていますね？
とりあえずその通りにしてみました。

「コード表」Sheetのシートモジュールにしてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myRow As Long, wS As Worksheet
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Set wS = Worksheets("データ")
With Target
If .Row > 1 And .Value <> "" Then
Cancel = True
myRow = wS.Cells(Rows.Count, "A").End(xlUp).Row + 1
wS.Cells(myRow, "A") = .Value
wS.Cells(myRow, "F") = .Offset(, 3) '//「データ」シートの"myRow"行、F列にD列の値を代入//
wS.Cells(myRow, "G") = .Offset(, 4) '//「データ」シートの"myRow"行、G列にE列の値を代入//
End If
End With
End Sub

こんな感じで良いのでしょうか？

※　細かいコードの説明は控えさせていただきます。m(_ _)m

No.2 ベストアンサー 回答者： tom04 回答日時： 2017/04/16 07:09

No.1です。

どうも失礼しました。
前回のコードに間違いがありました。
「コード表」シートのA列をそのままA列の最終行以降に表示させていました。

訂正したコードをもう一度記載しておきます。
（B列で最終行を取得するようにしています）

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myRow As Long, wS As Worksheet
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Set wS = Worksheets("データ")
With Target
If .Row > 1 And .Value <> "" Then
Cancel = True
myRow = wS.Cells(Rows.Count, "B").End(xlUp).Row + 1 '//←B列で最終行の次の行を取得★//
wS.Cells(myRow, "B") = .Value '//←ココが間違っていた（前回はA列に転記していました）★//
wS.Cells(myRow, "F") = .Offset(, 3) '//「データ」シートの"myRow"行、F列にD列の値を代入//
wS.Cells(myRow, "G") = .Offset(, 4) '//「データ」シートの"myRow"行、G列にE列の値を代入//
End If
End With
End Sub

※　「コード表」シートのA列を「データ」シートのB列に順次表示させるコードも記載しておきます。
今あるコードを消去し↓のコードにしてみてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myRow As Long, wS As Worksheet
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Set wS = Worksheets("データ")
With Target
If .Row > 1 And .Value <> "" Then
Cancel = True
myRow = wS.Cells(Rows.Count, "B").End(xlUp).Row + 1
wS.Cells(myRow, "B") = .Value
End If
End With
End Sub

これで「コード表」シートのA列をダブルクリックすると
「データ」シートのB列に順次表示されるはずです。m(_ _)m

No.3 回答者： tom04 回答日時： 2017/04/16 08:41

続けてお邪魔します。

最初の補足にある
＞単純にコード　A列をWクリックしたセルがデータB列に順次コピー転記できるように・・・
とは同じシート上でのコトでしょうか？

前回の後半のコードは「コード表」シートのA列をダブルクリックすると
「データ」シートのB列にその「値」が表示されるコードでした。

同一シート上での操作の場合は↓のコードにしてみてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
With Target
If .Value <> "" Then
Cancel = True
Cells(Rows.Count, "B").End(xlUp).Offset(1) = .Value
End If
End With
End Sub

※　今まで投稿したコードは上記コードを応用しただけです。m(_ _)m

この回答へのお礼

ごめんなさい。
データシートが1000行出来ていましたので、1001行目から新しくできていました。
削除してA2行から始めたら完璧でした。何度も何度も失礼なことお許しください。
ありがとうございました。

お礼日時：2017/04/16 09:08