EventDblClkListSelectRow

Public Function EventDblClkListSelectRow(ByRef Target As Range, _
                                         ByRef Cancel As Boolean, _
                                       ByRef ListArea As Range, _
                                      ByRef PasteCell As Range) _
                                                      As Boolean
'表範囲をダブルクリックしたときに、ダブルクリックした行の1行を指定セルにコピーする
'20220221
'20220921 Cell.Count→Cell.CountLarge
'20230714 転記処理を行ったらTrueを返す
'http://blog.livedoor.jp/aero_iki-jibundakemacro/archives/33784239.html

'下記例のイベントプロシージャをシートに作成すること
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'    Call EventDblClkListSelectRow(Target, Cancel, Range("B7:E10"), Range("B3"))
'End Sub

'引数
'Target   ・・・ダブルクリックしたセル
'Cancel   ・・・ダブルクリックイベントの引数Cancel
'ListArea ・・・ダブルクリックする表範囲
'PasteCell・・・貼り付け先のセルの基準セル
    
    Dim Cs     As Long: Cs = ListArea(1).Column              '開始列
    Dim Ce     As Long: Ce = ListArea(ListArea.CountLarge).Column '終了列
    Dim Rs     As Long: Rs = Target.Row                      '開始行
    Dim Sheet  As Worksheet: Set Sheet = Target.Parent       '対象シートの取得
    Dim Output As Boolean
    If Not Intersect(Target, ListArea) Is Nothing Then
        Dim CopyArea  As Range: Set CopyArea = Sheet.Range(Sheet.Cells(Rs, Cs), Sheet.Cells(Rs, Ce)) 'コピーする範囲のセル
        Dim PasteArea As Range: Set PasteArea = PasteCell.Resize(1, Ce - Cs + 1) '出力範囲のセル
        PasteArea.Value = CopyArea.Value '値コピー
        Cancel = True
        Output = True
    Else
        Output = False
    End If
    
    EventDblClkListSelectRow = Output
            
End Function