Okay, you also wanted to Format, well here is another module where I format each
spreadsheet once it's exported into Excel. Once again you will want to copy and
paste this into an Access module for easier reading. Note that the "oExcel"
object is declared publicly in my last bit of code I used to show you the export
feature.

Option Compare Database
Option Explicit
Sub ExcelFormat(NumRows As Integer)
'* Gives each department report  a better look and feel
Dim Borders As Variant 'Array
Dim LastColumn As String 'Specific Ranges
Dim i As Integer 'Counter
LastColumn = "D" & NumRows + 1
Borders = Array(xlEdgeBottom, xlInsideHorizontal)
With oExcel
.Range("E:E").Select 'We don't need this, it's the dept name next to each
emp.
.Selection.Delete SHIFT:=xlToLeft
.Range("C:C").Select
.Selection.HorizontalAlignment = xlLeft
.Range("A1:D1").Select
.Selection.Font.Bold = True
.Selection.HorizontalAlignment = xlCenter
With .Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
.Cells.Select
.Cells.EntireColumn.AutoFit
.ActiveWindow.DisplayGridlines = False
.Range("A1", LastColumn).Select
For i = 0 To 1
With .Selection.Borders(Borders(i))
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next
.Range("A1").Select
End With
End Sub
Sub FormatSummarySheet(bNextColumn As Boolean, iEmpTotal As Integer)
'* Formats the summary sheet, first by adding headers, and formatting them.
With oExcel
.Range("B1").Value = "Departments"
.Range("C1").Value = "Emp #"
.Range("B1:C1").Select
If bNextColumn = True Then
.Range("E1").Value = "Departments"
.Range("F1").Value = "Emp #"
.Range("B1,C1,E1,F1").Select
End If
.Selection.Font.Bold = True
With .Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With .Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells.Select
.Cells.EntireColumn.AutoFit
.ActiveWindow.DisplayGridlines = False
.Range("A1").Select
'Some final touches to give the report a title, and a better look
.Rows("1:3").Select
.Selection.Insert SHIFT:=xlDown
.Range("A1:F1").Select
With .Selection
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
.ActiveCell.Value = "Bridgewater Employee Report"
With .Selection.Font
.Name = "Arial"
.Size = 14
.ColorIndex = 11
End With
.Range("A2:C2").Select
With .Selection
.MergeCells = True
.HorizontalAlignment = xlRight
End With
.ActiveCell.Value = "Total Employees"
.Range("D2:E2").Select
With .Selection
.MergeCells = True
.HorizontalAlignment = xlLeft
End With
.ActiveCell.Value = iEmpTotal
.Columns("H:H").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
With .Selection.Interior
.ColorIndex = 1
End With
.Range("A1").Select
End With

End Sub

I have been use the following code to export my data  to excel  from Access. Much
of what you see below is a current module using the export code. The key points
are the "Private Type" at the beginning, accessing your data via the query seen
below, of course you will use your own query, and then exporting  it out to Excel
via the "Sub prep" procedure. I bolded out the parts of greatest interest.

You will want to copy this into a module to better read it. The way the "Sub
prep" procedure works is it takes the query and basically copies it into a
matching size cell range within Excel. You can alter the starting point of the
range as shown below, and of course create your own headers.


Option Compare Database
Option Explicit
'Excel Objects
Public WST As Object ' OLE automation object
Public oExcel As New Excel.Application
Public sHyperLink As String
Private Type ExlCell
row As Long
col As Long
End Type
Sub ReportExport()
'* Query recordset, store data into an array, export to Excel based by
department
'* Each sheet  is formatted, and a summary report  is also created.
On Error GoTo ReportExport_Error:
'Our Excel type
Dim StartingCell As ExlCell
'Database Objects
Dim db As Database
Dim rsEmp As Recordset
Dim qryEmpString As String
'Arrays
Dim EmpArray() As Variant
Dim DeptArray() As String
Dim HeaderArray() As Variant
'Counters
Dim col As Integer
Dim row As Integer
Dim NumRecs As Integer 'This represents number of records per query
Dim i As Integer
'ProgressBar Vaiables
Dim iDeptAmount As Integer
'For the spreadsheet
Dim SheetName As String
Dim iRowCounter As Integer
Dim bNextCol As Boolean 'This moves data to next column, but is there a simpler
method?
Dim iDeptSplit As Integer 'Determines split for summary sheet data.
Dim iTotalEmployees As Integer 'This tallies all employees
'Prepare headers for report
HeaderArray() = Array("Last", "First", "Shift", "Hire Date")
'Prepare workbook
oExcel.Workbooks.Add
StartingCell.row = 1
StartingCell.col = 1
Set db = CurrentDb
DeptList DeptArray, db, iDeptSplit 'Get the department list
iRowCounter = 1 'For summary sheet
iTotalEmployees = 0 'For summary sheet
iDeptAmount = UBound(DeptArray) 'For progress bar
'Get list of employees based on department and export to Excel
For i = 0 To UBound(DeptArray) - 2
qryEmpString = ( _
"Select Employees.LName, Employees.FName, Employees.Shift,
Employees.DateHired, " & _
"Departments.DepartmentName From qryCompleteEmployeeList " & _
"Where (((Employees.DeptID) = " & DeptArray(i) & ") AND ((Employees.Term)=
No));")
Set rsEmp = db.OpenRecordset(qryEmpString, dbOpenDynaset)
IncreaseBar i, iDeptAmount
If rsEmp.EOF And rsEmp.BOF Then
Else
rsEmp.MoveLast
NumRecs = rsEmp.RecordCount
ReDim EmpArray(rsEmp.RecordCount + 1, rsEmp.Fields.Count)
rsEmp.MoveFirst
SheetName = rsEmp!DepartmentName
'Copy column headings into some array
For col = 0 To UBound(HeaderArray)
EmpArray(0, col) = HeaderArray(col)
Next
'Get employee data
For row = 1 To rsEmp.RecordCount
For col = 0 To rsEmp.Fields.Count - 1
EmpArray(row, col) = rsEmp.Fields(col).Value
Next
rsEmp.MoveNext
Next
iTotalEmployees = iTotalEmployees + NumRecs 'For summary sheet total
Prep StartingCell, NumRecs, rsEmp, EmpArray, SheetName '1) Send data to
excel
CheckCount iRowCounter, bNextCol, iDeptSplit '2)Determines split for
summary sheet
SummarySheet iRowCounter, NumRecs, bNextCol '3) Enter data onto summary
sheet
End If
rsEmp.Close 'Closes each instance after we use it
Next
oExcel.Sheets("Sheet1").Select
FormatSummarySheet bNextCol, iTotalEmployees 'Format Summary Sheet
oExcel.Application.Visible = True 'Show report to user.
ReportExport_Exit:
'Clean House
Set WST = Nothing
Set oExcel = Nothing
db.Close
Exit Sub

ReportExport_Error:
MsgBox Err.Description
MsgBox Err.Number
Resume ReportExport_Exit:

End Sub
Sub Prep(stCell As ExlCell, RecNum As Integer, SN As Recordset, TheArray As
Variant, _
NameSheet As String)
Dim sReturnLink As String
'Prep the Excel Workbook
oExcel.ActiveWorkbook.Sheets.Add
Set WST = oExcel.ActiveWorkbook.Sheets(1)
WST.Name = NameSheet
'Copy data out to Excel
WST.Range(WST.Cells(stCell.row, stCell.col), _
WST.Cells(stCell.row + SN.RecordCount + 1, _
stCell.col + SN.Fields.Count)).Value = TheArray
'Return link to main sheet
sReturnLink = "A" & RecNum + 4
sHyperLink = "Sheet1!A1"
With oExcel
.Range(sReturnLink).Value = "Return"
.ActiveSheet.Hyperlinks.Add Anchor:=.Range(sReturnLink), Address:="",
SubAddress:= _
sHyperLink
End With
'Format data
ExcelFormat RecNum
End Sub