Code Snippets → Export A Table Or Query To Excel – To Specific Worksheet

Copy this code into a standard (not form or report) module. Name the module something other than this function name and make sure to set a reference to DAO if you don’t already have one.

Public Function SendTQ2ExcelSheet(strTQName As String, strSheetName As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
   
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field   
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
   
On Error GoTo err_handler    
strPath = “SET YOUR PATH TO THE WORKBOOK HERE OR USE A DIALOG TO GET IT”   
Set rst = CurrentDb.OpenRecordset(strTQName)   
Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Open(strPath)
    ApXL.Visible = True
       
    Set xlWSh = xlWBk.Worksheets(strSheetName)
  
    xlWSh.Activate
    xlWSh.Range("A1").Select
 
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next   
    rst.MoveFirst
 
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    ApXL.Selection.Font.Bold = True
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select   
    rst.Close
    Set rst = Nothing   
Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function