表末尾に選択行を切り取り貼り付け

切り取り貼り付けする度に、行が多くて何度もスクロールするのが嫌で作った。
選択するのはセルでも行でもOK。行を選択する手間が省けた。
いちいちスクロールすることなく末尾にヒョイヒョイ行を投げられる。
（そもそも表の構造がおかしい点は無視）

Sub 選択行を末尾に切り取り貼り付け()
    
    '最終行+1の取得（貼り付けする行）
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim insertRow As Long
    insertRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    'Debug.Print insertRow
    
    '選択行（セル）の検出
    Dim r As Range, rng As Range
    For Each r In Selection.Rows
        If rng Is Nothing Then
            Set rng = r.EntireRow
        Else
            Set rng = Union(rng, r.EntireRow)
        End If
    Next
    'Debug.Print rng.AddressLocal
    'Debug.Print rng.Areas.Count
    
    If rng.Areas.Count = 1 Then
        ws.Rows(rng.Address).Cut
        ws.Rows(insertRow).Insert
    Else
        MsgBox "離れた行の切り取り貼り付けは未対応です。"
        'エリア毎にやれば可能。行数の計算に注意。
    End If
    
End Sub

以上。