Exporteren vanuit Access naar een bereik in Excel

[modbeek]

Ik wil graag de resultaten van meerdere queries exporteren naar 1 werkblad in Excel (zijn kleine queries, maar 1 of een paar regels).

Dus bijv. query1 moet worden weggeschreven op werkblad "Resultaat" startend in cel A3
Query2 in hetzelfde tabblad startend cel A5, query 3 in A20.

Ik ben wat bezig geweest met macro Werkbladoverbrengen of VBA functie TransferSpreadsheet maar ik kom er niet uit.

Weet iemand of dit kan en zo ja hoe?

 

[Guus2005]

Als je onderstaande code een beetje aanpast doet het precies wat je wilt.

Public Sub CreateSpreadsheetFromRS(rst As Recordset, blnVisible As Boolean, Optional blnHeader As Boolean = True)
'Recordset exporteren naar excel.

    Dim appExcel  As Excel.Application
    Dim wbExcel   As Workbook
    Dim wsExcel   As Worksheet
    Dim qdf       As QueryDef
    Dim intRij    As Integer
    Dim intVelden As Integer
    Dim intTeller As Integer
        
    If Not rst.EOF Then
        Set appExcel = New Excel.Application
        With appExcel
            .Visible = blnVisible
            Set wbExcel = .Workbooks.Add
            Set wsExcel = wbExcel.Worksheets(1)
        End With
    Else
        MsgBox "Geen records gevonden voor " & rst.Name, vbExclamation, GetAppTitle()
        Exit Sub
    End If
    
    intVelden = rst.Fields.Count - 1
        
    intRij = 0
        
    If blnHeader Then 'Default worden de veldnamen geprint
        'Eerst de veldnamen
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller).Name
        Next intTeller
    End If
                
    Do While Not rst.EOF
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller)
        Next intTeller
        rst.MoveNext
    Loop
        
    wsExcel.Columns.AutoFit
    wsExcel.Rows.AutoFit
    appExcel.Visible = True
    appExcel.WindowState = xlMinimized
    
    Set rst = Nothing
    Set qdf = Nothing

End Sub

Enjoy!