【Excel】ダブルクリックで、範囲をコピペする。

質問

Excelで、以下のような操作ができるようにしたいです。

E2を ダブルクリックすると、
B3～C7の範囲をコピーして、E3～F7に貼り付け。

B9を ダブルクリックすると、
E3～F7の範囲をコピーして、B10～C14に貼り付け。

E9を ダブルクリックすると、
B10～C14の範囲をコピーして、E10～F14に貼り付け。

・
・
・

このような設定をしたいのですが、
よい方法を教えて下さい。

Excelは 2013です。

回答No.3

misatoanna · ベストアンサー

＃２ misatoanna です。

Ｂ列とＮ列だけの処理ですよね。

前回の記述で、
・Targetはダブルクリックしたセル
・そこから離れたセルが Offset(何行離れたか, 何列離れたか)
　　すぐ下のセルは Offset(1, 0) ということです。
・そこを起点に拡張されたセル範囲が Resize(範囲の行数, 範囲の列数)
です。

その部分とダブルクリックイベントを有効にするセル制限を書き替えればよいだけです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　If Target.Column <> 2 And Target.Column <> 14 Then Exit Sub　'列制限
　If (Target.Row + 24) Mod (28) <> 0 Then Exit Sub　'行制限
　If Target.Address = "$B$4" Then Exit Sub　'B4は対象外
　Cancel = True　'ダブルクリックしてもセル内編集モードにしない
　Select Case Target.Column
　　Case Is = 2　　'Ｂ列の場合
　　　Target.Offset(1, 0).Resize(26, 11).Value = Target.Offset(-27, 12).Resize(26, 11).Value
　　Case Is = 14　　'Ｎ列の場合
　　　Target.Offset(1, 0).Resize(26, 11).Value = Target.Offset(1, -12).Resize(26, 11).Value
　End Select
End Sub

お礼

大変わかりやすくご説明いただきまして
ありがとうございました。
これで表の形が変わっても使えそうです。

とても便利になりました。
毎日使う表なので、助かりました。

お世話になりました。

回答No.2

misatoanna

このような内容では・・・

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 And Target.Column <> 5 Then Exit Sub
If (Target.Row + 5) Mod (7) <> 0 Then Exit Sub
If Target.Address = "$B$2" Then Exit Sub
Cancel = True
Select Case Target.Column
Case Is = 2
Target.Offset(1, 0).Resize(5, 2).Value = Target.Offset(-6, 3).Resize(5, 2).Value
Case Is = 5
Target.Offset(1, 0).Resize(5, 2).Value = Target.Offset(1, -3).Resize(5, 2).Value
End Select
End Sub

お礼

ありがとうございます。

思い通りに動作してくれました。

補足

すみません。
表の作成をすすめていくうちに、表の範囲が広くなってしまいました。

N4を ダブルクリックすると、
B5～L30の範囲をコピーして、N5～X30に貼り付け。

B32を ダブルクリックすると、
N5～X30の範囲をコピーして、B33～L58に貼り付け。

N32を ダブルクリックすると、
B33～L58の範囲をコピーして、N33～X58に貼り付け。

・
・
・
このようにしたいのですが、どこの値を変更したら良いでしょうか。
お手数をお掛けして申し訳ございません。

宜しくお願いいたします。

回答No.1

mt2008

取りあえずこんなものでしょうか。

シートモジュールに入れて下さい。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　If (Target.Column <> 5) Or ((Target.Row Mod 7) <> 2) Then Exit Sub
　　Range(Target, Target.Offset(6, 1)) = Range(Target.Offset(0, -3), Target.Offset(6, -2)).Value
End Sub

お礼

B9を ダブルクリックすると、
E3～F7の範囲をコピーして、B10～C14に貼り付け。

これが上手く行きませんでした。
でも、ありがとうございました。