Excel VBA 配列 InputBoxでセル範囲指定一括代入

'セル範囲データを別シートのセルに書き出す
Sub ArraySample_07()
    Dim db() As Variant      'セルデ－タ処理
    Dim i As Long, j As Long 'Loopカウンタ
    Dim endr As Long        '最終行
    Dim endc As Long        '最終列
 
    'セル範囲取得
    With ThisWorkbook.Sheets("Sheet1")
        endr = .Cells.SpecialCells(xlCellTypeLastCell).Row
        endc = .Cells.SpecialCells(xlCellTypeLastCell).Column

        ReDim db(endr, endc)
        'CurrentRegionプロパティでセル範囲の値を代入
        db = .Range("A1").CurrentRegion.Value
    End With
 
    With ThisWorkbook.Sheets("Sheet2")
        For i = 1 To endr
            For j = 1 To endc
                .Cells(i, j) = db(i, j)
            Next
        Next
    End With
End Sub

'セル範囲データを2次元配列で一括処理する
Sub ArrayRangeSample_07()
    Dim db() As Variant　'動的配列()変数を用意
    Dim sr As Long       '開始行
    Dim sc As Long       '開始列
    Dim er As Long       '最終行
    Dim ec As Long       '最終列
    
    '取得セル範囲を2次元配列に一括代入する
    With ThisWorkbook.Sheets("Sheet1")
        db = .Range("A1").CurrentRegion.Value
        sr = LBound(db, 1)    '1次元の最小値（開始行）
        sc = LBound(db, 2)    '2次元の最小値（開始列）
        er = UBound(db, 1)    '1次元の最大値（最終行）
        ec = UBound(db, 2)    '2次元の最大値（最終列）
    End With
    '2次元配列をセル範囲に一括で代入
    With ThisWorkbook.Sheets("Sheet2")
        .Range(Cells(sr, sc), Cells(er, ec)) = db
    End With
End Sub

'選択セル範囲データを2次元配列で一括処理する
Sub InputRangeSample_07()
    Dim db() As Variant 'セルデ－タ取得用
    Dim sr As Long      '開始行
    Dim sc As Long      '開始列
    Dim er As Long      '最終行
    Dim ec As Long      '最終列
    Dim rng As Range    'セル選択用
    
    'Application.InputBoxで対象範囲のセルを選択させる
    On Error Resume Next
    Set rng = Application.InputBox( _
            Prompt:="取得したい連続したセル範囲を１つ選択してください", _
            Title:="セル選択", Type:=8)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub
    rng.Worksheet.Activate
    sr = rng.Row        '開始行取得
    sc = rng.Column     '開始列取得
    '取得セル範囲を2次元配列に一括代入する
    db = rng.Value
    Set rng = Nothing
    er = UBound(db, 1)   '1次元の最大値（最終行）
    ec = UBound(db, 2)   '2次元の最大値（最終列）
    'Application.InputBoxで貼付け先のセルを選択させる
    On Error Resume Next
    Set rng = Application.InputBox( _
            Prompt:="貼付け先のセル（表の左上）のセルを選択してください", _
            Title:="セル選択", Type:=8)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub
    rng.Worksheet.Activate
    sr = rng.Row            '貼付け先先頭セルの行番号
    sc = rng.Column         '貼付け先先頭セルの列番号
    '2次元配列をセル範囲に一括で代入
    Range(Cells(sr, sc), Cells(er + sr - 1, ec + sc - 1)) = db
End Sub

'セル範囲データを別シートのセルに書き出す
Sub RangeSample_07_rng()
    Dim rng As Range
    Dim sr As Long      '開始行
    Dim sc As Long      '開始列
    Dim er As Long      '最終行
    Dim ec As Long      '最終列
    
    'セル範囲取得
    With ThisWorkbook.Sheets("Sheet1")
        Set rng = .Range("A1").CurrentRegion
    End With
        sr = Range(rng(1).Address).Row
        sc = Range(rng(1).Address).Column
        er = rng.Rows.Count
        ec = rng.Columns.Count
    With ThisWorkbook.Sheets("Sheet2")
        .Activate
        .Range(Cells(sr, sc), Cells(er + sr - 1, ec + sc - 1)) = rng.Value
    End With
End Sub