How to improve code tranferring table to Excel

[lebrungr]

I have the following VBA codes which is working but I wonder how it could be made shorter and more efficient. I have Access 2010 and Excel 2007
I have a table called TempBudget in my Access database made up from the previous year incomes and expenses by month. I want to transfer this table(106 rows and 16 columns) to Excel as it is easier to manipulate spreadsheet in Excel. When I am satisfied with the budget, I want to transfer the table(spreadsheet) back to Access. I want to do everything thru VBA coding.
I tried to transfer the table to Excel with the DoCmd.Output and Docmd.TransferSpreadsheet but both don't transfer table with the xlsm format. I needed a way to get to an Excel file which included macro. [FONT=&quot]Here is the code:[/FONT]
[/code]On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "TempBudget", "C:\Data\FinancialProgram\TempBudget"
Call BudgetToExcel(BudgetYear)
Sub BudgetToExcel(BudgetYear)
' Late Binding (Needs no reference set)
Dim oXL As Object
Dim oExcel As Object
Dim sFullPath As String
Dim sPath As String
' Create a new Excel instance
Set oXL = CreateObject("Excel.Application")
On Error Resume Next
oXL.UserControl = True
On Error GoTo 0

Select Case (BudgetYear)
Case "2012"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2012.xlsm"

Case "2013"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2013.xlsm"

Case "2014"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2014.xlsm"

Case "2015"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2015.xlsm"

Case "2016"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2016.xlsm"

Case "2017"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2017.xlsm"

Case "2018"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2018.xlsm"

Case "2019"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2019.xlsm"

Case "2020"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2020.xlsm"

Case "2021"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2021.xlsm"

Case "2022"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\Budget2022.xlsm"

End Select

' Open it
With oXL
.Visible = True
.Workbooks.Open (sFullPath)

End With
ErrExit:
Set oXL = Nothing
Exit Sub
ErrHandle:
oXL.Visible = False
MsgBox Err.Description
GoTo ErrExit
End Sub

[FONT=&quot]When the budget file for a given year opens in Excel, I have the following code for the file in Excel (Thisworkbook):[/FONT]

Public Sub Workbook_Open()
Dim wb As Workbook
Dim ws As Worksheet
Set ws = ActiveSheet
Application.DisplayAlerts = False
Set wb = Workbooks.Open("C:\Data\FinancialProgram\TempBudget") ' import table in budgetyearX
wb.Worksheets(1).Cells.Copy
ws.Range("A1:O107").PasteSpecial
wb.Close
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B107") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort ' sort table by categoryID
.SetRange Range("A1:O107")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("P2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])" ' calculate total for each row and column
Range("P2").Select
Selection.Copy
Range("P2107").Select
ActiveSheet.Paste
Range("Q8").Select
Range("P19").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-17]C:R[-2]C)"
Range("D21:O107").Select
Range("D107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("E107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("F107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("G107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("H107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("I107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("J107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("K107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("L107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("M107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("N107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("O107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("R24").Select
Range("P20").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("P108").Select
Selection.ColumnWidth = 8.432 ' reset some column width
Range("C2").Select
Selection.ColumnWidth = 20
Range("A1").Select
Selection.ColumnWidth = 5
End Sub

[FONT=&quot]To bring the table back to Access to be used in various reports:[/FONT]

[FONT=&quot]Private Sub Command35_Click()[/FONT]
[FONT=&quot]Call Macro1[/FONT]
[FONT=&quot]End Sub[/FONT]
Function Macro1()
On Error GoTo Macro1_Err
DoCmd.TransferSpreadsheet acImport, 10, "Budget2013", "C:\Data\Quicken Replacement\Budget2013.xlsm", True, ""
Macro1_Exit:
Exit Function
Macro1_Err:
MsgBox Error$
Resume Macro1_Exit
End Function[/code]

 

[Rx_]

Could you put the code in Code tags go back to edit mode and:
in front of code open square brackets CODE close square brackets
at end of code open square brackets /CODE close square brackets

Actual code can vary in HTML format where code tags will preserve the code.
The code after When the budget file for a given year opens in Excel, I have the following code for thisworkbook:
Is this code running from Access or from inside Excel?
I seem to be missing the object reference if it is running from MS Access.

Just a suggestion:
Go to this Forums Code Samples (at top level) and search for the keyword Excel
You will find many examples such as this one I posted:
http://www.access-programmers.co.uk/forums/showthread.php?t=230617
Instead of a single question with one giant project, break your questions down to bite size answers.
The example above is how to take the user ID and create a custom network folder to hold the output rather than hard code it. That is one step in the process.

You are probably looking for something along the line of this (code fragment) with the keywords. This might give you some general ideas. This example, an object (ObjXL) was created from the Excel application (not shown) - it is a small code segment:

430   On Error GoTo PROC_Error ' not shown in this sample
440     ObjXL.Visible = False                                                              ' ******* change for production

450     ObjXL.Workbooks.Add
460     intWorksheetNum = 1
470     ObjXL.Visible = False   ' set for Production copy
480     intRowPos = 1       
490        ObjXL.Worksheets(intWorksheetNum).Name = "Sundry Completion Report"
       ' --- Create Query in variable against table(s) set up as it will appear in Excel           
strSQLSundries = "SELECT Wells_Areas.Area, States_2.State_Abrv AS State, Wells.Well_Name AS [Well Name], Wells_Status1.Status1 AS [Well Status], Wells_Lease_Type.Lease_Type AS [Lease Type],  ' Omitted rest of SQL for this example
530       strSQLSundries = strSQLSundries & _
          " WHERE (((Wells_Areas.ID_Area) In (2)) AND ' omitted rest of SQL for this example          
540       strSQLSundries = strSQLSundries & "ORDER BY Wells_Areas.Area, Well_Name_Sorted([Wells].[Well_Name]), Wells_Sundry_Description.Description; "          
550       Debug.Print strSQLSundries ' copy & paste into SQL designer to re-check
570       ObjXL.Visible = False ' Just hide - can change for testing
580         Set rsDataSundries = CurrentDb.OpenRecordset(strSQLSundries, dbOpenSnapshot, dbReadOnly) ' Open a recordset 
590         intRowPos = 6                                                                               ' Sets starting Row for data in Excel - reference fields to this
610         ObjXL.DisplayAlerts = False  ' Turn off Display Alerts
620         ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos, 1).CopyFromRecordset rsDataSundries
' Copy from recordset moves the query into Excel in one step
630         DoEvents
640         intMaxRecordCount = rsDataSundries.RecordCount - 1                                                      ' - use for max rows returned in formatting later
           'Debug.Print "max record count is " & intMaxRecordCount
                                                        ' ------- Create Header in new Excel based on Query
650       intMaxheaderColCount = rsDataSundries.Fields.count - 1
660       For intHeaderColCount = 0 To intMaxheaderColCount
670           If Left(rsDataSundries.Fields(intMaxheaderColCount).Name, 3) <> "xxx" Then  ' Future use - adding xxx in cross tab queries for fields to exclude
680               ObjXL.Worksheets(intWorksheetNum).Cells(intRowPos - 1, intHeaderColCount + 1) = rsDataSundries.Fields(intHeaderColCount).Name    ' Relative to intRowPos
690           End If
700       Next intHeaderColCount
' Copy from recordset moved data, this finished moving the headers
          'Debug.Print "Columns created count is " & intHeaderColCount
710       ObjXL.Rows((intRowPos - 1) & ":" & (intRowPos - 1)).Select   
' Now go and format the Excel data as needed