Private Sub XXXX_Click()
Dim cnn5 As ADODB.Connection
    Set cnn5 = CurrentProject.Connection
    Dim rstWeeklyTimeslips5 As New ADODB.Recordset
    rstWeeklyTimeslips5.ActiveConnection = cnn5
    Dim objWS5 As Excel.Worksheet
    Dim fld5 As ADODB.Field
    Dim objXL5 As Excel.Application
    Dim wbk5 As Excel.Workbook
    Dim intCol5 As Integer
    Dim intRow5 As Integer

The next like currently doesn't work, however once I made the Table based on the Union Query, I was to Export the Table, two rows down, called EBUSECGTemp
    'rstWeeklyTimeslips5.Open "EBUSandECG_RatiosByQuarter_Union", CurrentProject.Connection

    rstWeeklyTimeslips5.Open "EBUSECGTemp", CurrentProject.Connection
    
    
    Set objXL5 = New Excel.Application

    Set objWS5 = objXL5.Workbooks.Open("C:\Documents and Settings\t5000640\My Documents\ECG OA\ECG New Quarter Version\1Q_2012.xls").Sheets(6)
    
    For intCol5 = 0 To rstWeeklyTimeslips5.Fields.Count - 1
        Set fld5 = rstWeeklyTimeslips5.Fields(intCol5)
        'This is the First Row and Column of the Field Names
        'Therefore the first Column is Column 0 (intCol5 = 0) + 1
        objWS5.Cells(35, intCol5 + 1) = fld5.Name
    Next intCol5
    
  
    'This is the First Row of the Data
    intRow5 = 36
     'now the actual data
    Do Until rstWeeklyTimeslips5.EOF
        For intCol5 = 0 To rstWeeklyTimeslips5.Fields.Count - 1
        'This is the first Row and Column of the Data
        objWS5.Cells(intRow5, intCol5 + 1) = rstWeeklyTimeslips5.Fields(intCol5).Value
        Next intCol5
        rstWeeklyTimeslips5.MoveNext
        intRow5 = intRow5 + 1
    Loop
    objXL5.Visible = True
    
    rstWeeklyTimeslips5.Close
    
    Set cnn5 = Nothing
    Set objXL5 = Nothing
    Set wbk5 = Nothing
    Set objWS5 = Nothing
End Sub

Private Sub ReducedService_5_2_Click()
    'You need to change the objWS and wbk each quarter to the new Excel File name, which will be the date
    Dim cnn As ADODB.Connection
    Set cnn = CurrentProject.Connection
    Dim rstWeeklyTimeslips As New ADODB.Recordset
    Dim rstWeeklyTimeslips2 As New ADODB.Recordset
    Dim rstWeeklyTimeslips3 As New ADODB.Recordset
    Dim rstWeeklyTimeslips4 As New ADODB.Recordset
    
    rstWeeklyTimeslips.ActiveConnection = cnn
    rstWeeklyTimeslips2.ActiveConnection = cnn
    rstWeeklyTimeslips3.ActiveConnection = cnn
    rstWeeklyTimeslips4.ActiveConnection = cnn
    
    
    Dim MySheetPath As String
    
    Dim objXL As Excel.Application
    Dim wbk As Excel.Workbook
    Dim objWS As Excel.Worksheet
    
    Dim StartRange As Excel.Range
    Dim fld As ADODB.Field
    Dim fld2 As ADODB.Field
    Dim fld3 As ADODB.Field
    Dim fld4 As ADODB.Field
    Dim intCol As Integer
    Dim intCol2 As Integer
    Dim intCol3 As Integer
    Dim intCol4 As Integer
    Dim intRow As Integer
    Dim intRow2 As Integer
    Dim intRow3 As Integer
    Dim intRow4 As Integer
    
    
    rstWeeklyTimeslips.Open "ECGStep3", CurrentProject.Connection
    rstWeeklyTimeslips2.Open "ECGStep3ByQuarter", CurrentProject.Connection
    'rstWeeklyTimeslips3.Open "EBUSandECG_RatiosByMonth_Union", CurrentProject.Connection
    
    rstWeeklyTimeslips3.Open "EBUSECGTemp", CurrentProject.Connection
    rstWeeklyTimeslips4.Open "EBUSandECG_ALL_Table5_X_Averages", CurrentProject.Connection
    
    
    'Launch Excel
    'You need to update the name of the Spreedsheet/File below each quarter.
    Set objXL = New Excel.Application
    Set objWS = objXL.Workbooks.Open("C:\Documents and Settings\t5000640\My Documents\ECG OA\ECG New Quarter Version\1Q_2012.xls").Sheets(4)
    Set wbk = GetObject("C:\Documents and Settings\t5000640\My Documents\ECG OA\ECG New Quarter Version\1Q_2012.xls")
    
    'Copy the data
    'First the field names
    
    For intCol = 0 To rstWeeklyTimeslips.Fields.Count - 1
        Set fld = rstWeeklyTimeslips.Fields(intCol)
        'This is the First Row and Column of the Field Names
        'Therefore the first Column is Column 0 (intCol = 0) + 1
        objWS.Cells(1, intCol + 1) = fld.Name
    Next intCol
    
  
    'This is the First Row of the Data
    intRow = 2
     'now the actual data
    Do Until rstWeeklyTimeslips.EOF
        For intCol = 0 To rstWeeklyTimeslips.Fields.Count - 1
        'This is the first Row and Column of the Data
        objWS.Cells(intRow, intCol + 1) = rstWeeklyTimeslips.Fields(intCol).Value
        Next intCol
        rstWeeklyTimeslips.MoveNext
        intRow = intRow + 1
    Loop
    
    'Copy the data
    'First the field names
    
    For intCol2 = 0 To rstWeeklyTimeslips2.Fields.Count - 1
        Set fld2 = rstWeeklyTimeslips2.Fields(intCol2)
        'This is the First Row and Column of the Field Names
        'Therefore the first Column is Column 0 (intCol = 0) + 1
        objWS.Cells(36, intCol2 + 1) = fld2.Name
    Next intCol2
    
   'Set 2
    'This is the First Row of the Data
    intRow2 = 37
     'now the actual data
    Do Until rstWeeklyTimeslips2.EOF
        For intCol2 = 0 To rstWeeklyTimeslips2.Fields.Count - 1
        'This is the first Row and Column of the Data
        objWS.Cells(intRow2, intCol2 + 1) = rstWeeklyTimeslips2.Fields(intCol2).Value
        Next intCol2
        rstWeeklyTimeslips2.MoveNext
        intRow2 = intRow2 + 1
    Loop
    
    
    'Copy the data
    'First the field names
    'Set 3
    For intCol3 = 0 To rstWeeklyTimeslips3.Fields.Count - 1
        Set fld3 = rstWeeklyTimeslips3.Fields(intCol3)
        'This is the First Row and Column of the Field Names
        'Therefore the first Column is Column 0 (intCol3 = 0) + 1
        objWS.Cells(63, intCol3 + 1) = fld3.Name
    Next intCol3
    
  
    'This is the First Row of the Data
    intRow3 = 64
     'now the actual data
    Do Until rstWeeklyTimeslips3.EOF
        For intCol3 = 0 To rstWeeklyTimeslips3.Fields.Count - 1
        'This is the first Row and Column of the Data
        objWS.Cells(intRow3, intCol3 + 1) = rstWeeklyTimeslips3.Fields(intCol3).Value
        Next intCol3
        rstWeeklyTimeslips3.MoveNext
        intRow3 = intRow3 + 1
    Loop
    
    'Set 4
    For intCol4 = 0 To rstWeeklyTimeslips4.Fields.Count - 1
        Set fld4 = rstWeeklyTimeslips4.Fields(intCol4)
        'This is the First Row and Column of the Field Names
        'Therefore the first Column is Column 0 (intCol4 = 0) + 1
        objWS.Cells(70, intCol4 + 1) = fld4.Name
    Next intCol4
    
    'This is the First Row of the Data
    intRow4 = 71
     'now the actual data
    Do Until rstWeeklyTimeslips4.EOF
        For intCol4 = 0 To rstWeeklyTimeslips4.Fields.Count - 1
        'This is the first Row and Column of the Data
        objWS.Cells(intRow4, intCol4 + 1) = rstWeeklyTimeslips4.Fields(intCol4).Value
        Next intCol4
        rstWeeklyTimeslips4.MoveNext
        intRow4 = intRow4 + 1
    Loop
    wbk.Save
    objXL.Quit
    
    rstWeeklyTimeslips.Close
    rstWeeklyTimeslips2.Close
    rstWeeklyTimeslips3.Close
    rstWeeklyTimeslips4.Close
    
    Set cnn = Nothing
    Set objXL = Nothing
    Set wbk = Nothing
    Set objWS = Nothing
    


    'Set 5
    Dim cnn5 As ADODB.Connection
    Set cnn5 = CurrentProject.Connection
    Dim rstWeeklyTimeslips5 As New ADODB.Recordset
    rstWeeklyTimeslips5.ActiveConnection = cnn5
    Dim objWS5 As Excel.Worksheet
    Dim fld5 As ADODB.Field
    Dim objXL5 As Excel.Application
    Dim wbk5 As Excel.Workbook
    Dim intCol5 As Integer
    Dim intRow5 As Integer
    'rstWeeklyTimeslips5.Open "EBUSandECG_RatiosByQuarter_Union", CurrentProject.Connection
    rstWeeklyTimeslips5.Open "EBUSECGTemp", CurrentProject.Connection
    
    
    Set objXL5 = New Excel.Application
    'You need to change the name of the Spreedsheet/File in the objWS5 below each quarter.
    Set objWS5 = objXL5.Workbooks.Open("C:\Documents and Settings\t5000640\My Documents\ECG OA\ECG New Quarter Version\1Q_2012.xls").Sheets(6)
    
    For intCol5 = 0 To rstWeeklyTimeslips5.Fields.Count - 1
        Set fld5 = rstWeeklyTimeslips5.Fields(intCol5)
        'This is the First Row and Column of the Field Names
        'Therefore the first Column is Column 0 (intCol5 = 0) + 1
        objWS5.Cells(35, intCol5 + 1) = fld5.Name
    Next intCol5
    
  
    'This is the First Row of the Data
    intRow5 = 36
     'now the actual data
    Do Until rstWeeklyTimeslips5.EOF
        For intCol5 = 0 To rstWeeklyTimeslips5.Fields.Count - 1
        'This is the first Row and Column of the Data
        objWS5.Cells(intRow5, intCol5 + 1) = rstWeeklyTimeslips5.Fields(intCol5).Value
        Next intCol5
        rstWeeklyTimeslips5.MoveNext
        intRow5 = intRow5 + 1
    Loop
    objXL5.Visible = True
    
    rstWeeklyTimeslips5.Close
    
    Set cnn5 = Nothing
    Set objXL5 = Nothing
    Set wbk5 = Nothing
    Set objWS5 = Nothing
End Sub

DoCmd.OutputTo acOutputQuery, <<query name>>, AutoStart:=True