Sub PasteDataFromTBLToExcel2(strTbl As String, clTopLeft As Range, Optional lngRows As Long)

    Dim rst As DAO.Recordset
    Dim fld As DAO.Field

    Dim varRng() As Variant
    Dim i As Long
    Dim j As Long

    Dim lngRW As Long
    Dim lngCL As Long
    i = 0
    Set rst = CurrentDb.OpenRecordset(strTbl, dbOpenTable, dbReadOnly)
    lngRW = rst.RecordCount
    lngCL = rst.Fields.Count

    '全データを2次元配列に格納
    ReDim varRng(0 To lngRW - 1, 0 To lngCL - 1) As Variant
    rst.MoveFirst
    Do While Not rst.EOF
        For j = 0 To lngCL - 1
            varRng(i, j) = rst.Fields(j).Value
        Next j
        rst.MoveNext
        i = i + 1
    Loop

'    rst.MoveFirst
'    Do While Not rst.EOF
'        j = 0
'        For Each fld In rst.Fields
'            varRng(i, j) = fld.Value
'            j = j + 1
'        Next
'        rst.MoveNext
'        i = i + 1
'    Loop

    rst.Close

    With clTopLeft.Parent
        .Range(clTopLeft, clTopLeft.Offset(lngRW - 1, lngCL - 1)) = varRng
    End With


End Sub