VBAについて教えて頂けませんか。

Question

特定のセル以外コピー出来ないようにしたいです。

「 Sheet1!B3 」と「 Sheet1!B6 」と「 Sheet1!B9 」のどれかを
ダブルクリックすると、「 Sheet2!B3 」にコピーするようにし、
この３つのセル以外をダブルクリックしても
コピー出来ないようにしたいです。

ＶＢＡでこのような事は、可能でしょうか？
教えて頂けませんか？
よろしくお願いします。

myRange · Accepted Answer

またまた登場、myRangeです。一生懸命やってる人には加勢をせねば。。。(^^;;; ------------------------------------------------------------ (1)　("初期入力")Ｂ列の値の入れたいセルを、ダブルクリックし、("Data") を表示。 (2)　("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")のいずれかをダブルクリックする。 (3) (Data！) (FB63422,FE63422,FJ63422)をコピー。 (4) (3)を(拾い出し！) (AF)に値のみ貼り付け。 (5) (Data) (FP63367:FP63388)をコピー。 (6) (5)を(拾い出し！) (AK)に貼り付け。 (7) (2)でダブルクリックされた値を（初期入力！）で、ダブルクリックされたセルに貼り付け。上記のような処理だということですが、当方の疑問点に答えてないことがあります。 --------------------------------------------------------------------- （１）Range("FC63364").Activate '有効なデータの入れてないセルに戻す　　　　　　意味が分かりません。（２）(Data) (FP63367:FP63388)をコピー　　　ＦＰ列１列コピーなのに、.Resize(1, 5)　と５列扱っている（３）ＡＦ，ＡＫの転記開始行のひとつ上のセルには何か入力されているか　　　転記行を取得するときに問題になるそれからもうひとつ（４）Range("FP63367:FP63388")をコピーする部分で　　　If Rng.Value <> "" Then　　というコードがありますが　　　これはこれでいいのですですか？ '--------------------------------------------------------------------- で、疑問点（１）は省略疑問点（２）～（３）は質問者提示のまま疑問点（４）は、”ある”ということで上記(1)～(7)の条件でのコードは以下のようになります。 '------------------------------------------------------------ ●標準モジュール（初期入力にＤａｔａの値を転記するための変数） '------------------------------------------------------------- 　　Public myCell As Range '-------------------------------------------------------- '●(初期入力)のコード '--------------------------------------------------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 　　If Target.Column <> 2 Then Exit Sub 　　Cancel = True 　　If Target.Value <> "" Then 　　　　MsgBox ("値が入っているセルは選べません。") 　　　　Exit Sub 　　End If 　　Set myCell = Target　　'▲ダブルクリックしたセルを覚えておく　　Sheets("Data").Activate End Sub '---------------------------------------------------------- ’●（Ｄａｔａ）のコード '---------------------------------------------------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 　Dim Rng As Range 　Dim LastRow As Long 　Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402") 　If Intersect(Target, Rng) Is Nothing Then Exit Sub 　Cancel = True 　myCell.Value = Target.Value　　'▲▲初期入力のアクティブセルに値を代入　LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row 　Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF") 　For Each Rng In Range("FP63367:FP63388") 　　　If Rng.Value <> "" Then 　　　　　LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row 　　　　　Sheets("拾い出し").Cells(LastRow + 1, "AK").Value = Rng.Value 　　　End If 　Next Rng End Sub '--------------------------------------------------------------------- 乗りかかった船ですのでこの質問が解決するまではお付き合いするつもりです。疑問点な遠慮なく質問してください。以上です。　

myRange · Answer

回答２、myrangeです。

回答２にミスがありますので訂正します。

'--------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


'■Range("FC63364").Activate '有効なデータの入れてないセルに戻す
'■Sheets("初期入力").Activate
'■'選択した値を("初期入力")に戻す
'■ActiveCell.Value = Target.Value

'■の部分は何をしたいのか不明です。
'も少し分かりやすく文章で説明した方がいいでしょう。


　Dim Rng As Range
　Dim LastRow As Long

　Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")

　If Not Intersect(Target, Rng) Is Nothing Then
　　LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row
　　Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF")

　For Each Rng In Range("FP63367:FP63388")
　　If Rng.Value <> "" Then
　　　　LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
　　　●Sheets("拾い出し").Cells(LastRow + 1, "AK").Resize(1, 5).Value = Rng.Resize(1, 5).Value
　　End If
　Next Rng

　　　Cancel = True
　End If
End Sub
'---------------------------------------------------------------------

IF～EndIfの範囲のミス、及び、Cancel=Trueが抜けてました。
　
以上です。

myRange · Answer

＞（内容）
＞(1) （初期入力！）セルをダブルクリックより（Data！）に移動して来ました。

これは、意味不明です。
　

　
やりたいことは、Dataシートのセルをダブルクリックして
Dataシートの該当セルを、”拾い出し”シートのセルにコピーしたい
ということでしょうか。

で、あれば、
▲Data▲シートのBeforeDoubleClickイベントに以下のコードを。

'--------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


'■Range("FC63364").Activate '有効なデータの入れてないセルに戻す
'■Sheets("初期入力").Activate
'■'選択した値を("初期入力")に戻す
'■ActiveCell.Value = Target.Value

'■の部分は何をしたいのか不明です。
'も少し分かりやすく文章で説明した方がいいでしょう。


　Dim Rng As Range
　Dim LastRow As Long

　Set Rng = Range("EP63367,EP63381,EP63402,EP63388,EP63395,EP63402")

　If Not Intersect(Target, Rng) Is Nothing Then
　　LastRow = Sheets("拾い出し").Cells(Rows.Count, "AF").End(xlUp).Row
　　Range("FB63422,FE63422,FJ63422").Copy Sheets("拾い出し").Cells(LastRow + 1, "AF")
　End If

　For Each Rng In Range("FP63367:FP63388")
　　If Rng.Value <> "" Then
　　　　LastRow = Sheets("拾い出し").Cells(Rows.Count, "AK").End(xlUp).Row
　　　●Sheets("拾い出し").Cells(LastRow + 1, "AK").Resize(1, 5).Value = Rng.Resize(1, 5).Value
　　End If
　Next Rng
End Sub
'---------------------------------------------------------------------


再質問では、
'("Data")("FP63367:FP63388")をコピーとなってますが
上記コードの●の部分では、Resize(1,5)となってますので
ＦＰ～ＦＴ列、ＡＫ～ＡＯの５列の値を扱うようになってます。
それでいいのですか？

また、上記コードにSheets("Data")が出てこないのは、
Sheets("Data")がActiveSheetなので省略しているからです。

それから、転記先のＡＦ、ＡＫの転記開始行のセルのひとつ上には
最終行（LastRow）を取得するために、何かしらの文字が入力されていること。
入力されていないなら、質問者のコードのように、転記開始行かどうかの判断が必要です。
以上です。

rivoisu · Answer

Sheet1のシートタブを右クリックするとコードを記入するウインドが現れます。
以下のコードを記入します。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 Then '列が2 (B列)で
    If Target.Row = 3 Or Target.Row = 6 Or Target.Row = 9 Then  '行が3,6,9のとき
        Worksheets("Sheet2").Range("B3") = Target.Value         'Sheet2のB3に代入
        Cancel = True                                           'ダブルクリックの通常の処理をCancel
    End If
End If
End Sub

VBAについて教えて頂けませんか。

またまた登場、myRangeです。

この回答への補足

回答２、myrangeです。

＞（内容）

この回答への補足

Sheet1のシートタブを右クリックするとコードを記入するウインドが現れます。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング