Export Query Result to an Existing Excel Sheet in MS Access

The below function will export your all data from MS Access Query result to an existing Excel sheet.

Public Function SendTQ2XLWbSheet2(strTQName As String, strSheetName As String, strFilePath As String)
 Dim db As DAO.Database
 Set db = CurrentDb()
    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 = strFilePath
     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

 'formatting Excel tab
 '======A1 row formatting======='
    xlWSh.Range("A1").Value = "Heading_Name" 
    xlWSh.Range("A1").Interior.Color = RGB(255, 228, 196)
    xlWSh.Range("A1").Columns.Font.Bold = True
    xlWSh.Range("A1").Font.Size = 14
    xlWSh.Range("A1").HorizontalAlignment = xlCenter
    '====Table Header moving and fomatting========'
    xlWSh.Range("A2:S2").Select
    xlWSh.Range("A2:S2").Interior.Color = RGB(169, 169, 169)
    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    Next
    rst.MoveFirst
    xlWSh.Range("A3").CopyFromRecordset rst
' =====Data will pasted from A3 row ======='
     rst.Close
     Set rst = Nothing
     xlWBk.Close True
    Set xlWBk = Nothing
    ApXL.Quit
    Set ApXL = Nothing
Exit_SendTQ2XLWbSheet4:
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendTQ2XLWbSheet4
   End Function

Execution Process

Private Sub Command5_Click()
Dim db As DAO.Database
Set db = CurrentDb()
Dim path As String
path = CurrentProject.path
Dim fName As String
fName = "23 MHS_Q1-Q2-Q3-Q4 Status_12Jun17-QuarterlyReport.xlsx" (excel file name)
Dim p As String
p = path & "\" & fName
If SendTQ2XLWbSheet2("Query_Name", "Tab_Name(in Excel)", p ) = True Then
End If
MsgBox "Excel Report Created...!!!"
End Sub