Sub GetExcel(strSourceFile As String, strSQL As String, ByRef Massiv() As Variant)
Dim cn As ADODB.Connection
Dim rstTemp As ADODB.Recordset

Set cn = New ADODB.Connection
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DriverId=790;ReadOnly=True;" & "DBQ=" & strSourceFile & ";"
Set rstTemp = New ADODB.Recordset

rstTemp.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
Erase Massiv
    x =  1 
        With rstTemp
        Do While Not .EOF
                    .MoveNext
                      x = x +  1 
            Loop
    End With
ReDim Massiv( 1  To x,  1  To rstTemp.Fields.Count) As Variant
rstTemp.MoveFirst
                For i =  0  To rstTemp.Fields.Count -  1 
                Massiv( 1 , i +  1 ) = rstTemp.Fields(i).Name
                Next i
            
            For j =  0  To x -  2 
                For i =  0  To rstTemp.Fields.Count -  1 
                Massiv(j +  2 , i +  1 ) = rstTemp.Fields(i)
                Next i
            rstTemp.MoveNext
            Next j

rstTemp.Close
cn.Close

Set rstTemp = Nothing
Set cn = Nothing
End Sub


Sub DOIT()
Dim strSourceFile As String, strSQL As String, Massiv() As Variant
strSourceFile = "E:\Test\1.xls"
strSQL = "SELECT * FROM `Лист1$`;"

Call GetExcel(strSourceFile, strSQL, Massiv)
Sheets( 1 ).Range(Cells( 1 ,  1 ), Cells(UBound(Massiv,  1 ), UBound(Massiv,  2 ))).Value = Massiv


End Sub