Data van access versturen naar excel in verschillende sheets.

[xps351]

Zo dan?

WB.Sheets.Add.Name = "WTCH"    
strSQL = "TRANSFORM Sum(Tbl_HCCount.Score) AS SumOfScore1 " & _
             "SELECT [ExhibitorStock] & ' ' & [ExhibitorStockJ] AS Exhibitor, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore AS [Total Score]" & _
             "FROM (DateTrailDays INNER JOIN ((DR_CLass_Level INNER JOIN (Tbl_SubHCCount INNER JOIN Tbl_HCCount ON Tbl_SubHCCount.Stamboomnr = Tbl_HCCount.Stamboomnr) " & _
             "ON DR_CLass_Level.ClassID = Tbl_HCCount.StockKlasID) INNER JOIN Tbl03_Dogs ON Tbl_SubHCCount.Stamboomnr = Tbl03_Dogs.Stamboomnr) " & _
             "ON DateTrailDays.SanctionNR = Tbl_HCCount.Trail) INNER JOIN Tbl09_Stock " & _
             "ON (DateTrailDays.SanctionNR = Tbl09_Stock.Trail) AND (DR_CLass_Level.ClassID = Tbl09_Stock.StockKlasID) AND (Tbl03_Dogs.Stamboomnr = Tbl09_Stock.Stamboomnr)" & _
             "WHERE Tbl03_Dogs.WTCH = [COLOR=#ff0000][B]True [/B][/COLOR]" & _
             "GROUP BY [ExhibitorStock] & ' ' & [ExhibitorStockJ], Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore " & _
             "PIVOT [Class_LevelName] & ' ' & Date() & ' ' & [Timepoint] & ' ' & [Judge]"

    Set rs = CurrentDb.OpenRecordset(strSQL)

Respectievelijk

WB.Sheets.Add.Name = "NON_WTCH"    
strSQL = "TRANSFORM Sum(Tbl_HCCount.Score) AS SumOfScore1 " & _
             "SELECT [ExhibitorStock] & ' ' & [ExhibitorStockJ] AS Exhibitor, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore AS [Total Score]" & _
             "FROM (DateTrailDays INNER JOIN ((DR_CLass_Level INNER JOIN (Tbl_SubHCCount INNER JOIN Tbl_HCCount ON Tbl_SubHCCount.Stamboomnr = Tbl_HCCount.Stamboomnr) " & _
             "ON DR_CLass_Level.ClassID = Tbl_HCCount.StockKlasID) INNER JOIN Tbl03_Dogs ON Tbl_SubHCCount.Stamboomnr = Tbl03_Dogs.Stamboomnr) " & _
             "ON DateTrailDays.SanctionNR = Tbl_HCCount.Trail) INNER JOIN Tbl09_Stock " & _
             "ON (DateTrailDays.SanctionNR = Tbl09_Stock.Trail) AND (DR_CLass_Level.ClassID = Tbl09_Stock.StockKlasID) AND (Tbl03_Dogs.Stamboomnr = Tbl09_Stock.Stamboomnr)" & _
             "WHERE Tbl03_Dogs.WTCH = [B][COLOR=#ff0000]False [/COLOR][/B]" & _
             "GROUP BY [ExhibitorStock] & ' ' & [ExhibitorStockJ], Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore " & _
             "PIVOT [Class_LevelName] & ' ' & Date() & ' ' & [Timepoint] & ' ' & [Judge]"
    
    Set rs = CurrentDb.OpenRecordset(strSQL)

 

[OctaFish]

Tijd voor de simpele (en snelle) oplossing . Nieuwe query op basis van de kruistabel (nieuwe naam gegeven).

Private Sub ToExcel_Click()
Dim qdf As DAO.QueryDef, rst As DAO.Recordset, fld As DAO.Field
Dim appExcel As Excel.Application, wbk As Excel.Workbook, wks As Excel.Worksheet
Dim i As Integer
    
    Set appExcel = New Excel.Application
    appExcel.Visible = True
    'Recordset True
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_HCreportStock_To_Excel WHERE WTCH=True;")
    Set wbk = appExcel.Workbooks.Add()
    Set wks = wbk.Worksheets(1)
    For i = 0 To rst.Fields.Count - 1
        wks.Cells(1, i + 1).value = rst.Fields(i).Name
    Next i
    wks.Range("A2").CopyFromRecordset rst
    'Recordset False
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_HCreportStock_To_Excel WHERE WTCH=False;")
    Set wks = wbk.Worksheets.Add
    For i = 0 To rst.Fields.Count - 1
        wks.Cells(1, i + 1).value = rst.Fields(i).Name
    Next i
    wks.Range("A2").CopyFromRecordset rst
    
End Sub

 

[allard1977]

Heren,

heel erg bedankt voor jullie hulp alweer. de codes werken allebei ben er zeer blij mee. ik denk tot de volgende keer.

Groet Allard

 

[Pletter]

Een stukje korter:

Private Sub ToExcel_Click()

Dim rst As DAO.Recordset
Dim appExcel As Excel.Application, wbk As Excel.Workbook, wks As Excel.Worksheet
Dim i As Integer, x As Integer

Set appExcel = New Excel.Application
appExcel.Visible = True
Set wbk = appExcel.Workbooks.Add()
Set wks = wbk.Worksheets(1)
    
    For x = -1 To 0
        Set rst = CurrentDb.OpenRecordset("SELECT * FROM [Copy Of Qry_HCreportStockExcel] WHERE WTCH= (" & x & ");")
            For i = 0 To rst.Fields.Count - 1
                   wks.Cells(1, i + 1).value = rst.Fields(i).Name
            Next i
        wks.Range("A2").CopyFromRecordset rst
        If x < 0 Then Set wks = wbk.Worksheets.Add
    Next x

End Sub

Groetjes