Public Function LalExcExp(tableName As String, excelPath As String, sheetName As String, cellTarget As String)
On Error GoTo err_description
Dim iFF As Integer, retval As Boolean
iFF = FreeFile
Open excelPath For Random Access Read Write Lock Read Write As #iFF
retval = (Err.Number <> 0)
Close #iFF
If retval = True Then
MsgBox "Файл кем то открыт, закройте excel: " & excelPath
Exit Function
Else
DoCmd.Hourglass True
Set objExcel = CreateObject("Excel.Application")
Set WB = objExcel.Workbooks.Open(excelPath)
Set WS = WB.Sheets(sheetName)
Set rs = CurrentDb.OpenRecordset(tableName)
objExcel.Visible = False
WS.Range(cellTarget).CopyFromRecordset rs
WB.Close True
Set WB = Nothing
objExcel.Quit
Set objExcel = Nothing
rs.Close
Set rs = Nothing
DoCmd.Hourglass False
MsgBox "Таблица успешно добавлена!"
End If
Exit Function
err_description: MsgBox Err.Description
End Function

LalExcExp "з_счета", "C:\Users\user1\Desktop\тест.xls", "листок 2", "A1"

Public Function ExportExcelTwo(tableName As String, excelPath As String, sheetName As String, cellTarget As String)
On Error GoTo err_description
Dim iFF As Integer, retval As Boolean
iFF = FreeFile
On Error Resume Next
Open excelPath For Random Access Read Write Lock Read Write As #iFF
retval = (Err.Number <> 0)
Close #iFF
If retval = True Then
MsgBox "Файл кем то открыт, закройте excel: " & excelPath
Exit Function
Else
On Error GoTo err_description
Set rs = CurrentDb.OpenRecordset(tableName)
If rs.RecordCount = 0 Then
MsgBox "В выбираемой таблице/запросе 0 строк, вставлять нечего!"
rs.Close
Set rs = Nothing
Exit Function
Else
DoCmd.Hourglass True
Set objExcel = CreateObject("Excel.Application")
Set WB = objExcel.Workbooks.Open(excelPath)
Set WS = WB.Sheets(sheetName)
objExcel.Visible = False
row_id = WS.Range(cellTarget).row
col_id = WS.Range(cellTarget).Column
fieldCount = rs.Fields.Count
rs.MoveLast
rs.MoveFirst

Do Until rs.EOF
    For Each fld In rs.Fields
        If col_id = fieldCount Then
            WS.cells(row_id, col_id) = rs(col_id - 1)
                col_id = WS.Range(cellTarget).Column
                    rs.MoveNext
        Else
            WS.cells(row_id, col_id) = rs(col_id - 1)
                col_id = col_id + 1
        End If
    Next fld
        row_id = row_id + 1
    Loop
    
WB.Close True
Set WB = Nothing
objExcel.Quit
Set objExcel = Nothing
rs.Close
Set rs = Nothing
DoCmd.Hourglass False
MsgBox "Таблица успешно добавлена!"
  End If
End If
Exit Function
err_description: MsgBox Err.Description
End Function

ExportExcelTwo "ваша_таблица_запрос", "C:\путь\тест.xls", "Лист 2", "A1"