Import Data from Access Query Results to Excel using VBA

[excel6000]

I have some code which runs a few queries to get some data from an Access database. In my code below, you will see towards the bottom several lines of code which I have tried to use to import this data, but none of them have worked for me. This is why I have turned them into comments. The line which reads "Worksheets("Div 1").Cells(246, 1).CopyFromRecordset rst1" actually imports data, but it just imports whatever data the query is returning for that specific instant ("WSName" is a variable which changes). I need to import the data based on the rst1 variable which changes and this is why I have tried things like "div 5" and "div 1" as these are the names of the changing variables.

Sub GetData()
    Dim appAccess As Access.Application
    Dim Db  As DAO.Database
    Dim rstsum, rst1, rst2 As DAO.Recordset


    Set appAccess = Access.Application
    
    Set Db = appAccess.CurrentDb


    strsql = "SELECT EstimateSummary.WSName, EstimateSummary.PrtCode " & _
                "FROM EstimateSummary " & _
                "WHERE (((EstimateSummary.PrtCode)=""1""));"


    Set rstsum = Db.OpenRecordset(strsql)
    
    Do While Not rstsum.EOF
        strsql = "SELECT EstimateDetail.SheetName, EstimateDetail.EstFlag, EstimateDetail.HdrRow, EstimateDetail.EstOrder, EstimateDetail." & _
                            "[*ExtDesc], EstimateDetail.[*ExtCalcQty], EstimateDetail.[*ExtUoM], EstimateDetail.[*ExtTotalU], EstimateDetail.[*ExtTotalCost]" & _
                    " FROM EstimateDetail" & _
                    " WHERE (((EstimateDetail.SheetName) = " & Chr(34) & rstsum("WSName") & Chr(34) & ") And ((EstimateDetail.HdrRow) = 3))" & _
                    " ORDER BY EstimateDetail.EstOrder;"
    
        Debug.Print strsql
        
        Set rst1 = Db.OpenRecordset(strsql)
        
        '... some code to import
        
        'Worksheets("Div 1").Cells(246, 1) = rst1("SheetName")
        
        'Sheets("Div 5").Add.rst1 ("div 5")
                
        'Worksheets("Div 1").Cells(246, 1) = rst1("Div 1")


        'Worksheets("Div 1").Cells(246, 1).CopyFromRecordset rst1
                
        'Div 1.Range(“A1").CopyFromRecordset rst1
        
        rstsum.MoveNext
    
    Loop
    
End Sub