エクセル 複数範囲の中の１セルを転記させる

こんにちは、エクセル365を使っています。

範囲
Range("V2:V8,W2:W7,X2:X6,Y2:Y5,Z2:Z4,AA2:AA3,AB2")
の中の値をAC2に値として貼り付けたいのですが、一番簡単な方法はどういったものでしょうか。

数分おきにこの中の特定の数値をAC２に転記する作業があり、かと言って一つ一つにマクロを設定するのもなんだかスマートでは無いような気がします。

詳しい方、教えて頂けませんか、よろしくお願い致します。

１回に、１つ選んでペーストする感じです。

ちなみにこのシートには既にマクロが書いてあり、以下のような物です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, j As Long, js As Long

If Intersect(Target, Range("R17:S50,AC1")) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target.Row = 1 Then
If Target.Value <> "" Then
Range("AC42").End(xlUp).Offset(1) = Target.Value
Range("AC1").ClearContents '//←AC1セルのデータを残す場合はこの行は不要★//
Range("AC2:AC41").Sort key1:=Range("AC2"), order1:=xlAscending, Header:=xlNo
End If
Else '//★//
Range("V17:U50").ClearContents
For i = 17 To 50
If Cells(i, "R") <> "" Then
For j = i To 50
If Cells(j, "S") <> "" Then
If Application.CountIf(Range("X17:X50"), Cells(i, "R") & Cells(j, "S")) > 0 Then
Cells(Cells(Rows.Count, "V").End(xlUp).Row + 1, "V") = Cells(j, "S") & Cells(i, "R")
Else
Cells(Cells(Rows.Count, "U").End(xlUp).Row + 1, "U") = Cells(i, "R") & Cells(j, "S")
End If
End If
Next
End If
If Cells(i, "S") <> "" Then
For js = i To 50
If Cells(js, "R") <> "" Then
If Application.CountIf(Range("X17:X50"), Cells(i, "S") & Cells(js, "R")) > 0 Then
Cells(Cells(Rows.Count, "U").End(xlUp).Row + 1, "U") = Cells(js, "R") & Cells(i, "S")
Else
Cells(Cells(Rows.Count, "V").End(xlUp).Row + 1, "V") = Cells(i, "S") & Cells(js, "R")
End If
End If
Next
End If
Next
Call Range("U17:U50").Sort(key1:=Range("U17"), order1:=xlAscending)
Call Range("V17:V50").Sort(key1:=Range("V17"), order1:=xlAscending)
End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R17:S24,AC2:AC50")) Is Nothing Then Exit Sub
Cancel = True
Target.ClearContents
End Sub

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2020/09/25 19:31

＃１です。

思った通りの動きで良かったです。
色々あると思いますが、私なりに理解しました。
頑張ってくださいね。。

この回答へのお礼

ありがとうございます。
とても嬉しいです。

お礼日時：2020/09/25 19:33

No.1 回答者： Qchan1962 回答日時： 2020/09/25 19:04

こんばんは、

いつずつ選んでAC2に入力したいと言う事で良いのでしょうか？
幸い、Changeイベントには絡まないようなので、対象範囲をダブルクリックで
AC２セルに入力します。AC2セルは、ダブルクリックの違う処理が設定されているので
AC2セルをダブルクリックするとクリアーされると思います。
果たして仕様に合うのかわかりませんが、
示されているPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)を下記に書き換えます。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("R17:S24,AC2:AC50,V2:V8,W2:W7,X2:X6,Y2:Y5,Z2:Z4,AA2:AA3,AB2")) Is Nothing Then Exit Sub
Cancel = True
If Not Intersect(Target, Range("V2:V8,W2:W7,X2:X6,Y2:Y5,Z2:Z4,AA2:AA3,AB2")) Is Nothing Then
Range("AC2").Value = Target.Value
Exit Sub
End If
Target.ClearContents
End Sub

回答は、参考なので、
判らない処理をどんどん付け足してプログラムを作って大丈夫かと
心配ですが、ここまで来たら、その時は、覚悟して学習してくださいね。

この回答へのお礼

わっ、ありがとうございます。
思った通りの動きで嬉しいです。

ちなみにAC1なのにAC２って書いてしまう私って、、、落ち着きがないと言うかなんと言うか（笑）

マクロの勉強でしょう？

本当はやったほうが良いのですが、一人である事に挑戦してまして、正直時間が取れないので、みなさんに助けられております。

ほんとありがとうございます。

お礼日時：2020/09/25 19:21