Option Explicit

'''  ******************使い方**********************************
''' 「Microsoft Forms 2.0 Object Library」を参照設定します。
'''　**********************************************************
Sub コピーEX()
    'ワーク初期化
    Dim コピーEX_Work() As Variant
    ReDim コピーEX_Work(Selection.Rows.Count - 1)

    Dim arrayCount As Long
    Dim idx As Long
    arrayCount = 0
    idx = 0
    '配列にセルの内容を貯め込む
    For idx = Selection(1).row To Selection(Selection.Count).row
        ''コピペ用セル値を貯め込む
        コピーEX_Work(arrayCount) = Cells(idx, Selection(1).Column).Value
        arrayCount = arrayCount + 1
    Next idx

    '配列からクリップボード用テキスト作成
    Dim text As String
    Dim i As Integer
    For i = 0 To UBound(コピーEX_Work)
        text = text + CStr(コピーEX_Work(i)) + vbCrLf
    Next i

    'クリップボードに送る
    With New MSForms.DataObject
        .SetText text     '変数の値をDataObjectに格納する
        .PutInClipboard   'DataObjectのデータをクリップボードに格納する
    End With

End Sub

Sub 貼り付けEX()

    Dim cbFormat As Variant
    Dim clipText As String
    With New MSForms.DataObject
        .GetFromClipboard    ''変数のデータをDataObjectに格納する

        cbFormat = Application.ClipboardFormats
        If cbFormat(1) <> 0 Then
            MsgBox "クリップボードにテキストが入っていません"
            Exit Sub
        End If

        clipText = .GetText
    End With

    Dim arr As Variant
    arr = Split(clipText, vbCrLf)
    ReDim Preserve arr(UBound(arr) - 1) '余計な改行分削除

    'アクティブセル取得
    Dim ac As Range
    Set ac = Selection(1)
    Dim idx As Long
    idx = 0
    For idx = 0 To UBound(arr)
        ac.Offset(idx, 0).Value = arr(idx)
    Next idx

End Sub


Sub クリップボードモード切り替え()
  Static mode As Boolean
  mode = Not mode
  If mode Then
    Application.StatusBar = "★拡張クリップボードモード---- 【コピー：F3】　【貼り付け：F4】"
    Application.OnKey "{F3}", "コピーEX"
    Application.OnKey "{F4}", "貼り付けEX"
  Else
    Application.StatusBar = ""
    Application.OnKey "{F3}", ""
    Application.OnKey "{F4}", ""
  End If
End Sub