Sub a()
Dim oConn  As Object
Dim oRS As Object
Dim sFilename As String
Dim sConnect As String
Dim sSQL As String
Dim i As Long, j As Long
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
sFilename = "c:\Mytest\Volker1.xls"
    sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                "Data Source=" & sFilename & ";" & _
                "Extended Properties=Excel 8.0;"
Set oRS = CreateObject("ADODB.Recordset")
sSQL = "SELECT Last_Name, " & vbNewLine & _
           "       First_Name, " & vbNewLine & _
           "       Budget_Code, " & vbNewLine & _
           "       SUM(Amount), " & vbNewLine & _
           "       SUM(Quantity1) AS 'Quantity1', " & vbNewLine & _
           "       SUM(Quantity2) AS 'Quantity2', " & vbNewLine & _
           "       SUM(Quantity3) AS 'Quantity3' " & vbNewLine & _
           "FROM [Sales$] " & vbNewLine & _
           "WHERE Budget_Code = 1110 " & vbNewLine & _
           "GROUP BY Last_Name, First_Name, Budget_Code"
    oRS.Open sSQL, sConnect, adOpenForwardOnly, _
                adLockReadOnly, adCmdText
' Check to make sure we received data.
    If Not oRS.EOF Then
    For i = 1 To oRS.fields.Count
        Cells(1, i).Value = oRS.fields.Item(i - 1).Name
    Next i
    Range("A2").CopyFromRecordset oRS
    For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Cells(j, i).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])*0.5"
    Next j
    Else
    MsgBox "No records returned.", vbCritical
    End If
' Clean up our Recordset object.
    oRS.Close
    Set oRS = Nothing
End Sub