Заполнение результатами запроса Access таблицу Excel

Добрый день!
Подскажите, пожалуйста, каким образом заполнить имеющуюся таблицу в Excel данными, полученными в результате выполнения запроса?
Имеются 3 запроса - у каждого есть 2 поля <Имя> <Значение>.
В файле Excel есть три таблицы на одном листе, каждый запрос выводит данные для своей таблицы - 1 запрос-1 таблица.
Если можно, поподробнее :).
Большое спасибо:)

rus_75

Если можно, поподробнее

в эксель есть соответствующие инструменты

Get External Data - из эксель создаете мастером запрос к таблицам эксес
и там-же указываете диапазоны в которых нужно разместить даные

все...

вариант кодом

Private Sub Кнопка0_Click()
    
    Dim cnn As ADODB.Connection:            Dim rst As ADODB.Recordset
    Set cnn = CurrentProject.Connection:    Set rst = New ADODB.Recordset

    Dim XLS As Excel.Application            ' Microsoft Excel 11.0 Object Library
    Set XLS = New Excel.Application
    XLS.Workbooks.Open CurrentProject.Path & "\Книга1.xls"
    
        rst.Open "SELECT * FROM Запрос1", cnn, adOpenStatic, adLockReadOnly
        XLS.Worksheets("Лист1").Range("A2").CopyFromRecordset rst
        rst.Close
        
        rst.Open "SELECT * FROM Запрос2", cnn, adOpenStatic, adLockReadOnly
        XLS.Worksheets("Лист1").Range("D2").CopyFromRecordset rst
        rst.Close

        rst.Open "SELECT * FROM Запрос3", cnn, adOpenStatic, adLockReadOnly
        XLS.Worksheets("Лист1").Range("G2").CopyFromRecordset rst
        rst.Close
        
    XLS.ActiveSheet.SaveAs CurrentProject.Path & "\Книга1.xls"
    XLS.Quit
    
    cnn.Close
    
    Set rst = Nothing
    Set XLS = Nothing
    Set cnn = Nothing

End Sub

Option Compare Database
Option Explicit

Private Const StVS = "Все"
Private Const StVL = "Анализ работы военкоматов"
Private Const StDs = "СтатистикаДиаг"
Private Const StDsL = "Анализ повторяющихся диагнозов"

Public Sub St()

Dim rsv As ADODB.Recordset
Dim rsd As ADODB.Recordset
    
    ' Переменные ексель
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
        
    Dim i As Integer
    
    On Error GoTo HandleErr
       Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Add
    xlApp.DisplayAlerts = False
    For i = xlBook.Worksheets.Count To 3 Step -1
        xlBook.Worksheets(i).Delete
    Next i
    xlApp.DisplayAlerts = True
        
    Set xlSheet = xlBook.ActiveSheet
    xlSheet.NAME = StDsL
    
    ' Create recordset
    Set rsd = New ADODB.Recordset
    rsd.Open _
     Source:=StDs, _
     ActiveConnection:=CurrentProject.Connection
    
    With xlSheet
        ' Шрифт полей и копирование полей
        With .Cells(2, 1)
            .Value = rsd.Fields(0).NAME
           .Font.Bold = True
        End With
       With .Cells(2, 2)
            .Value = rsd.Fields(1).NAME
            .Font.Bold = True
        End With
        ' Копирование
        .Range("A3").CopyFromRecordset rsd
     '___________________________Форматирование диагнозов
    
    .Columns("a:a").ColumnWidth = 80
    .Columns("b:b").ColumnWidth = 20
    .Cells(1, 1).Value = "Анализ часто повторяющихся диагнозов"
        .Range("A1").Font.Size = 14
        .Range("A1").Font.Bold = True
        .Range("A:A").HorizontalAlignment = xlLeft
        .Range("A:A").VerticalAlignment = xlTop
        .Range("A:A").WrapText = True
        .Range("A:A").Orientation = 0
        .Range("A:A").AddIndent = False
        .Range("A:A").IndentLevel = 0
        .Range("A:A").ShrinkToFit = False
        .Range("A:A").ReadingOrder = xlContext
        .Range("A:A").MergeCells = False
        .Range("A2").HorizontalAlignment = xlCenter
        .Range("A2").VerticalAlignment = xlBottom
        .Range("A1").HorizontalAlignment = xlCenter
        .Range("A1").VerticalAlignment = xlBottom
        .Range("B:B").HorizontalAlignment = xlCenter
        .Range("B:B").VerticalAlignment = xlBottom
    End With
        
    rsd.Close
    Set rsd = Nothing
    '_______________________________________________________
       xlBook.Sheets(2).Select
       Set xlSheet = xlBook.ActiveSheet
       xlSheet.NAME = StVL
       
        Set rsv = New ADODB.Recordset
    rsv.Open _
     Source:=StVS, _
     ActiveConnection:=CurrentProject.Connection
    
    With xlSheet
        
        With .Cells(2, 1)
            .Value = rsv.Fields(0).NAME
           .Font.Bold = True
        End With
       With .Cells(2, 2)
            .Value = rsv.Fields(1).NAME
            .Font.Bold = True
        End With
        With .Cells(2, 3)
            .Value = rsv.Fields(2).NAME
            .Font.Bold = True
        End With
        With .Cells(2, 4)
            .Value = rsv.Fields(3).NAME
            .Font.Bold = True
        End With
        With .Cells(2, 5)
            .Value = rsv.Fields(4).NAME
            .Font.Bold = True
        End With
               
        .Range("A3").CopyFromRecordset rsv
               '_________________Форматирование военкоматов
        
        .Columns("a:a").ColumnWidth = 30
        .Range("A1").Font.Size = 14
        .Range("A1").Font.Bold = True
        .Range("A:A").HorizontalAlignment = xlLeft
        .Range("A:A").VerticalAlignment = xlBottom
        .Range("A:A").WrapText = True
        .Range("A:A").Orientation = 0
        .Range("A:A").AddIndent = False
        .Range("A:A").IndentLevel = 0
        .Range("A:A").ShrinkToFit = False
        .Range("A:A").ReadingOrder = xlContext
        .Range("A:A").MergeCells = False
        .Range("A2").HorizontalAlignment = xlCenter
        .Range("A2").VerticalAlignment = xlBottom
        .Range("A1:E1").Merge
        .Range("B:B").HorizontalAlignment = xlCenter
        .Range("B:B").VerticalAlignment = xlBottom
        .Range("C:C").HorizontalAlignment = xlCenter
        .Range("C:C").VerticalAlignment = xlBottom
        .Range("D:D").HorizontalAlignment = xlCenter
        .Range("D:D").VerticalAlignment = xlBottom
        .Range("E:E").HorizontalAlignment = xlCenter
        .Range("E:E").VerticalAlignment = xlBottom
        .Range("A1:E1").Select
        .Range("A1:E1").HorizontalAlignment = xlCenter
        .Range("A1:E1").VerticalAlignment = xlTop
        .Cells(1, 1).Value = "Анализ работы военкоматов"
                       
       End With
      
    xlApp.Visible = True
    ExitHere:
    On Error Resume Next
    rsv.Close
    Set rsv = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub
    
HandleErr:
   MsgBox Err & ": " & Err.Description, , "Error in CreateExcelChart"
   Resume ExitHere
    
End Sub
Криво, но работает