http://rghost.ru/58278886

'Объявляем переменные
Dim XL As Object
Dim XLT As Object
Dim newrow As Object
Dim rsd As ADODB.Recordset
Dim ZMN As String

Set rsd = New ADODB.Recordset
'Запрос к базе данных
ZMN = "select * from tbl_1"
rsd.Open ZMN, CurrentProject.Connection
'Создаем необходимые объекты
Set XL = CreateObject("Excel.Application")
'для примера показываю, как можно сразу загружать шаблон без выбора
Set XLT = XL.Workbooks.Open("D:\ЗБК\Книга999.xlsx")
'2 способ если строк в источнике несколько
'причем мы учтем то, что у нас есть шапка и примечание в Excel
'и мы не знаем, сколько строк у нас вставиться
'и поэтому строки будем добавлять в случае необходимости
'зададим, с какой строки будем начинать вставлять данные
Rowss = 10
'для нумерации
numrow = 1
'запускаем цикл до тех пор, пока не закончатся строки в нашем источнике
While Not (rsd.EOF)
'смотрим, если строк больше чем мы задали в шаблоне
If Rowss >= 12 Then
'то добавляем строку
XLT.Worksheets("Лист1").Rows(Rowss).Insert
'Запомним нашу строку
Set newrow = XLT.Worksheets("Лист1").Rows(Rowss)
'и вставим туда копию предыдущей строки
'для того если вдруг у вас там есть объединенные ячейки или какие-то нужные данные
'так как новая строка создастся без всяких объединений и значений
XLT.Worksheets("Лист1").Rows(Rowss - 1).Copy newrow
'это просто для примера как можно очистить некий диапазон внутри документа
'XLT.Worksheets("Лист1").Range("A10:F10").ClearContents
'динамически формируем адрес нужной ячейки
с = "a" & Rowss
'и задаем ей значение
XLT.Worksheets("Лист1").Range(cell) = numrow
cell = "b" & Rowss
XLT.Worksheets("Лист1").Range(cell) = rsd.Fields("field5").Value
'переходим на следующую строку
Rowss = Rowss + 1
'переходим на следующую строку в источнике данных
rsd.MoveNext
Else
'а это выполняется до тех пор, пока не закончатся заданные строки в шаблоне
'т.е. если строк в источнике всего 1 то в код, который выше мы даже не попадем
cell = "a" & Rowss
XLT.Worksheets("Лист1").Range(cell) = numrow
cell = "b" & Rowss
XLT.Worksheets("Лист1").Range(cell) = rsd.Fields("field5").Value
Rowss = Rowss + 1
rsd.MoveNext
End If
'для нумерации
numrow = numrow + 1
'конец цикла
Wend

End Sub

-http://zmey.1977.ru/Access_To_Excel_Ru.htm#a1
-http://info-comp.ru/obucheniest/299--access-export-v-word-excel.html