Sub test()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim x, y, z
    
    Set cn = New ADODB.Connection
    cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;" & _
        "ReadOnly=True;DBQ=" & ThisWorkbook.FullName & ";"

    Set rs = New ADODB.Recordset
    rs.Open "SELECT * FROM [Sheet1$]", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
    'копируем первую строку рекордсета в массив (транспонируем по желанию)
    x = Application.Transpose(rs.GetRows( 1 ))
    
    'копируем остальные строки рекордсета в массив (транспонируем по желанию)
    y = Application.Transpose(rs.GetRows)
    
    'возвращаемся на первую строку рекордсета
    rs.MoveFirst
    
    'копируем все строки рекордсета в массив (транспонируем по желанию)
    z = Application.Transpose(rs.GetRows)
    
    'возвращаемся на первую строку рекордсета
    rs.MoveFirst
    
    'копируем первую строку рекордсета в ранг
    Sheets( 2 ).Range("A1").CopyFromRecordset rs,  1 
    
    'копируем остальные строки рекордсета в ранг
    Sheets( 2 ).Range("A3").CopyFromRecordset rs

    'и т.д. 
    
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub