Option Compare Database Option Explicit Sub cmdExport_Click() Dim strEnts As String, strSQL As String, strFName As String, skelFN As String Dim cdb As DAO.Database Dim varEnt As Variant Set cdb = CurrentDb On Error GoTo Error_cmdExport strFName = CurrentProject.Path & "\Hoveret_Milgot.xlsx" skelFN = CurrentProject.Path & "\skel\skel.xlsx" strEnts = "" FileCopy skelFN, strFName strSQL = "SELECT DISTINCT [entitled] FROM [scholl]" With cdb.OpenRecordset(strSQL, dbOpenSnapshot) Call .MoveFirst Do While Not .EOF strEnts = strEnts & "," & !entitled Call .MoveNext Loop Call .Close End With strEnts = Mid(strEnts, 2) For Each varEnt In Split(strEnts, ",") If Len(CStr(varEnt)) = 0 Then GoTo Continue1 End If Call DoCmd.CopyObject(, varEnt, acQuery, "query1") Set cdb = CurrentDb With cdb.QueryDefs(varEnt) strSQL = Replace(.SQL, ";", "") & "WHERE [entitled] = '%E'" .SQL = Replace(strSQL, "%E", varEnt) Application.RefreshDatabaseWindow End With Call DoCmd.TransferSpreadsheet(acExport, acSpreadsheetTypeExcel12Xml, varEnt, strFName, True) 'DoCmd.OutputTo acOutputQuery, varEnt, acFormatXLSX, strFName, False DoCmd.DeleteObject acQuery, varEnt Set cdb = Nothing Continue1: Next varEnt Call MsgBox("finished", vbOKOnly, "Excel export") Exit Sub Error_cmdExport: MsgBox "Error {" & Err & "}" & vbNewLine & Err.Description, vbOKOnly Or vbExclamation, "cmdExport" Title:="cmdExport") End Sub