VBA 表で連番をどこからでも付けれるコードを教えて下さい。

台帳を作成しています。シートは添付の画像のとおりです。一連番号をD７から順に１～の連番を付したコードは動きますが、例えば6桁の123456～連番を付すとE列に転記しません。D2に123456、E2に１３と入力するとD列７行目の123456番号の横のE７に店舗IDが自動表示されるようにしています。
コードは次のとおりです。教えて下さい。

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column <> 5 Or .Count > 1 Then Exit Sub
If .Address = "$E$2" Then
If WorksheetFunction.CountBlank(Range("D2:E2")) = 0 Then
With Cells(Range("D2") + 6, "E")
.Value = Range("E2")
.Offset(, -3) = Now()
Range("B2").Value = Now()
End With
Range("E2").ClearComments
End If
End If
End With
End Sub

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

• tom4様
  いつも有り難う御座います。おかげ様でやっと終着駅にたどり着きそうです。最後にエラー発生ですが、「オブジェクトはこのプロパティまたはメゾットをサポートしてません」の「Selection.ClearContents」が黄色になります。どうしたら良いのでしょうか。教えて下さい。

    補足日時：2018/01/08 21:10

No.5 ベストアンサー 回答者： tom04 回答日時： 2018/01/08 19:07

こんばんは！

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, c As Range, myRng As Range
If Target.Address = "$E$2" Then
If WorksheetFunction.CountBlank(Range("D2:E2")) = 0 Then
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
Set myRng = Range(Cells(7, "D"), Cells(lastRow, "D"))
With Target
Set c = myRng.Find(what:=Range("D2"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = .Value
c.Offset(, -2) = Now() '//←B・C列が結合されているようなので、「-2」としている//
Range("B2") = Now()
Range("E2").Select
Selection.ClearContents
Else
MsgBox "該当番号なし"
.Select
End If
End With
End If
End If
End Sub

こんな感じをお望みなのでしょうか？m(_ _)m

この回答へのお礼

有り難う御座いました。

お礼日時：2018/01/08 21:37

No.6 回答者： tom04 回答日時： 2018/01/08 21:16

No.5です。

＞「Selection.ClearContents」が黄色になります

ん～～～
こちらのExcel画面で画像通りの配置でデータを入力し、再確認しましたが
ちゃんと動きます。
当然のコトですが、シートモジュールいしていますよね？

その1行を
＞Range("E2").ClearContents

に変えたらどうなりますか？m(_ _)m

この回答へのお礼

すみませんでした。再確認したら最後のコードの「ｓ」が入力ミスでした。完璧に作動しました。有り難う御座いました。私の作業を最後までご指導・ご教授いただき感謝申し上げます。

お礼日時：2018/01/08 21:37

No.4 回答者： GooUserラック 回答日時： 2018/01/08 18:23

チャント動かないコードを提示されても、どういう動きが正解なのかが判りません。

【Q1】こんな事でしょうか？
① E2セルに店舗コードを入力すると D2セルの値を D7セルから下を検索して見つかった行の E列に店舗コードを書き込む
② その行の B列に現時刻を書き込む
③ E2セルをクリアする
④ B2セルに現時刻を書き込む
⑤ D2セルの値をカウントアップする ← ここのコードは無いのですがタイトルからこれも必要かと…

【Q2】なお⑤ですが D列に対象の値が無くなった時はどうするのでしょうか？
【Q3】⑤の後ですが選択セルはどこに持って行けばよいのでしょうか？

この回答へのお礼

ご丁寧なご教授を有り難う御座いました。いろんな所に参照していますので説明が十分でなくて済みませんでした。

お礼日時：2018/01/08 21:37

No.3 回答者： GooUserラック 回答日時： 2018/01/08 18:05

No.1 と No.2 の訂正

すみません。とんだ勘違いをしていました。
「.Count」を「.Column」対の「.Row」だと勘違いしていました。
本当に申し訳ございませんでした。

この回答へのお礼

有り難う御座いました。

お礼日時：2018/01/08 21:37

No.2 回答者： GooUserラック 回答日時： 2018/01/08 18:01

No.1 の追記

動作がよく判らないので、No.1でダメなら「If .Column <> 5 Or .Count > 1 Then Exit Sub」を「If .Column <> 5 Or .Count = 1 Then Exit Sub」に変えてテストしてみてください。

この回答へのお礼

有り難う御座います。

お礼日時：2018/01/08 21:37

No.1 回答者： GooUserラック 回答日時： 2018/01/08 17:55

全部見た訳ではありませんが「If .Column <> 5 Or .Count > 1 Then Exit Sub」を「If .Column <> 5 Or .Count <> 2 Then Exit Sub」に変えてテストしてみてください。

この回答へのお礼

有り難う御座います。

お礼日時：2018/01/08 21:37