A few years ago I wrote a routine to copy an Access query or table to a block of Excel cells because I was having issues with DoCmd.TransferSpreadsheet not being able to always do what I needed.

I found that copying the entire recordset to an array variable and then setting the target range of cells using that array was quite fast. I figured I’d share the Subroutine. It requires you to pass in an Excel application object, an SQL statement or table or query name, and optionally the name of the sheet you want it to go on to and optionally the starting row and column.

Here is that subroutine for your enjoyment!

' ----------------------------------------------------------------
' Procedure Name: ExportToExcelSheet
' Purpose: Imports the table or query data into the specified worksheet
'          starting at the specified row and column.  You can call it
'          multiple times with different sheet names and table or query values.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter objExcelApp (Object): handle to an Excel Workbook
' Parameter strTableOrQuery (Variant): query or table
' Parameter strSheetName (Variant): option sheet name
' Parameter intRowStart (Integer): optional starting parameter for the row
' Parameter intColumnStart (Integer): optional starting parameter for the column
' Author: jon
' Date: 10/2/2019
' ----------------------------------------------------------------
#Const ExcelRef = 0 
Public Sub ExportToExcelSheet(ByRef objExcelApp As Object,strTableOrQuery As Variant,_ 
   Optional strSheetName As Variant =  "",Optional intRowStart As Integer = 2,Optional intColumnStart As Integer = 1) 
#If ExcelRef = 0 Then  ' Late binding
    
   If HALutil.ReferenceLibraryExists( "Excel") Then References.Remove References!Excel 
    
   Dim objExcel As Object 

#Else  ' a reference to MS Excel  Object Library must be specified
    
   Dim objExcel As Excel.Application 

#End If 
   
   Set objExcel = objExcelApp 
   'objExcel.ScreenUpdating = False
   
   Dim DbCurrent As DAO.Database 
   Dim rsData As DAO.Recordset 
   Dim iRec As Integer,intColumn As Integer 
    
   DoCmd.Hourglass True 
   
   Set DbCurrent = CurrentDB 
   Set rsData = DbCurrent.OpenRecordset(strTableOrQuery) 
    
   If rsData.RecordCount <= 0 Then 
      HALutil.MsgBox  "No records match selection criteria",vbOKOnly + vbInformation, "MRP"
      rsData.Close 
      DbCurrent.Close 
      Set rsData = Nothing 
      Set DbCurrent = Nothing 
      objExcel.Quit 
      Exit Sub 
   End If 
    
   On Error GoTo 0 
    
   If strSheetName <>  "" Then objExcel.Sheets(strSheetName).Activate 
    
   iRec = intRowStart 
    
   Dim arrData As Variant,rowcount As Integer 
   rsData.MoveLast 
   rsData.MoveFirst 
   ReDim arrData(rsData.RecordCount - 1,rsData.Fields.Count - 1) 
   rowcount = 0 
   While Not rsData.EOF 
      For intColumn = 0 To rsData.Fields.Count - 1 
         arrData(rowcount,intColumn) = rsData(intColumn) 
      Next intColumn 
      rowcount = rowcount + 1 
      rsData.MoveNext 
   Wend 
    
   With objExcel 
      .Range(.Cells(iRec,intColumnStart),.Cells(iRec + rsData.RecordCount - 1,intColumnStart + rsData.Fields.Count - 1)).Value = arrData 
   End With 
    
   rsData.Close 
   Set rsData = Nothing 
   DbCurrent.Close 
   Set DbCurrent = Nothing 
    
   DoCmd.Hourglass False 
    
Exit_Err_cmdExport_Click: 
   Exit Sub 
    
Err_cmdExport_Click: 
   HALutil.MsgBox  "Error Number: " & Err.Number &  " " & Err.Description 
   Resume Exit_Err_cmdExport_Click 

End Sub