'CSVファイルデータをセル範囲へコピーするマクロ

'出力開始位置のセルを選択してMyCSVCopyマクロを実行してください。

Option Explicit

Sub MyCSVCopy()
    Const myTitle = "CSVファイルデータをセル範囲へコピー"
    Dim range1 As Range
    Dim v As Variant

    If TypeName(Selection) <> "Range" Then
        MsgBox "セル範囲を選択して実行してください。", _
            vbExclamation, myTitle
        Exit Sub
    End If

    'ファイル選択
    v = Application.GetOpenFilename(fileFilter:=StrConv( _
        "CSV ファイル (*.csv),*.csv,すべてのファイル (*.*),*.*", vbNarrow))
    If VarType(v) = vbBoolean Then Exit Sub

    Application.ScreenUpdating = False
    Select Case CSVFileCopyToRange(ActiveCell, CStr(v), True)
        Case 0
        Case -1
            MsgBox "処理はキャンセルされました。", vbExclamation, myTitle
        Case Else
            MsgBox Error(Err) & " (" & Err & ")", vbExclamation, myTitle
    End Select
End Sub

Function CSVFileCopyToRange(range1 As Range, filename As String, _
        ask As Boolean) As Integer
    Const myTitle = "CSVファイルデータをセル範囲へコピー"
    Dim book1 As Workbook, range2 As Range
    Dim state1 As Boolean

    CSVFileCopyToRange = -1
    On Error GoTo err_1

    'CSVファイルをオープン
    Set book1 = Workbooks.Open(filename:=filename)

    'コピー範囲を取得
    Set range2 = ActiveSheet.UsedRange

    'コピー先セルを選択する
    range1.Worksheet.Parent.Activate
    range1.Worksheet.Select
    range1.Resize(range2.Rows.Count, range2.Columns.Count).Select

    If ask Then
        state1 = Application.ScreenUpdating
        Application.ScreenUpdating = True
        If MsgBox("CSVファイルの内容を選択範囲にコピーします。" & Chr$(10) _
                & range2.Rows.Count & " 行 " & range2.Columns.Count & _
                " 列あります。", _
                vbOKCancel Or vbExclamation, myTitle) <> vbOK Then
            If MsgBox("CSVファイルを閉じますか？", _
                    vbOKCancel Or vbExclamation, myTitle) = vbOK Then
                book1.Close False
            End If
            Application.ScreenUpdating = state1
            Exit Function
        End If
        Application.ScreenUpdating = state1
    End If

    '貼り付け
    range2.Copy
    ActiveSheet.Paste

    'CSVファイルを閉じる
    Application.CutCopyMode = False
    book1.Close False

    CSVFileCopyToRange = 0
    Exit Function
err_1:
    CSVFileCopyToRange = Err
End Function