Export same table in the same workbook in diff worksheet

a7n9

Well-known Member
Joined
Sep 15, 2004
Messages
696
Hi,

I'm running some simulations in Access using VBA and I create a table named "Results".

I've created "Export button" to export the Results table to the file selected by the user. However, I'm not able to export this table with a different name or change the worksheet name.

Here is the code I'm using, can someone please modify this so that, the results table will be exported to the worbook I select but with a different worksheet name every time.

Here's the code I got till now<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> cmdExport_Click()
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> errorhandler1
<SPAN style="color:#00007F">Dim</SPAN> strOPFilename <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> obj1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>
<SPAN style="color:#00007F">If</SPAN> fIsAppRunning("Excel") <SPAN style="color:#00007F">Then</SPAN>
  )  )  ) <SPAN style="color:#00007F">Set</SPAN> obj1 = GetObject(, "Excel.Application")
<SPAN style="color:#00007F">Else</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> obj1 = CreateObject("Excel.Application")
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
strOPFilename = obj1.GetSaveAsFilename(, "Excel files (*.xls), *.xls", , "Select the file name/location")
<SPAN style="color:#00007F">If</SPAN> strOPFilename = "" <SPAN style="color:#00007F">Or</SPAN> strOPFilename = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN>
    MsgBox "Not a valid filename, try again", vbCritical, Prog_TItle
    <SPAN style="color:#00007F">GoTo</SPAN> errorhandler1
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Results", strOPFilename

<SPAN style="color:#00007F">Set</SPAN> obj1 = <SPAN style="color:#00007F">Nothing</SPAN>
MsgBox "Results exported to " & strOPFilename & " succesfully!", vbInformation
<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN> <SPAN style="color:#007F00">'if there is no error exit the sub</SPAN>
errorhandler1:
<SPAN style="color:#007F00">'If Err.Number = 2501 Then</SPAN>
<SPAN style="color:#007F00">'    MsgBox "Output location/file was not selected, Results were not exported", vbCritical, Prog_TItle</SPAN>
<SPAN style="color:#00007F">If</SPAN> Err.Number <> 0 <SPAN style="color:#00007F">Then</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> msg <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    msg = "Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
    MsgBox msg, vbCritical, Prog_TItle & "-Error", Err.HelpFile, Err.HelpContext
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Set</SPAN> obj1 = <SPAN style="color:#00007F">Nothing</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>>
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Could you please clean up the posted code?:)
 
Upvote 0
All right, I did it now.. :biggrin: HTML maker aptly puts "&nbsp" for a Tab but somehow it can't be seen on these pages. I replaced them with " "
 
Upvote 0
I see you have a reference to an instance of Excel.

Could you not use this to open the workbook and rename the exported sheet as required?
Code:
Private Sub cmdExport_Click()
On Error GoTo errorhandler1
Dim strOPFilename As Variant
Dim obj1 As Object
Dim wb As Object
Dim ws As Object

    If fIsAppRunning("Excel") Then
        Set obj1 = GetObject(, "Excel.Application")
    Else
        Set obj1 = CreateObject("Excel.Application")
    End If
    strOPFilename = obj1.GetSaveAsFilename(, "Excel files (*.xls), *.xls", , "Select the file name/location")
    If strOPFilename = "" Or strOPFilename = False Then
        MsgBox "Not a valid filename, try again", vbCritical, Prog_TItle
        GoTo errorhandler1
    End If
    
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Results", strOPFilename
    
    Set wb = obj1.Workbooks.Open(strOPFilename)
    
    Set ws = wb.Worksheets("Result")
    
    ws.Name = "NewSheetName"
    
    Set ws = Nothing
    Set wb = Nothing
    Set obj1 = Nothing
    
    MsgBox "Results exported to " & strOPFilename & " succesfully!", vbInformation
    
    Exit Sub
    
errorhandler1:
    If Err.Number <> 0 Then
        Dim msg As String
        msg = "Error # " & Str(Err.Number) & " was generated by " _
                & Err.Source & Chr(13) & Err.Description
        MsgBox msg, vbCritical, Prog_TItle & "-Error", Err.HelpFile, Err.HelpContext
    End If
    
    Set obj1 = Nothing
    
End Sub
 
Upvote 0
Thanks for your reply, Norie. Yes, I was trying to do similar kind of thing yesterday but it wasn't working, I'll try your suggestion.

Also, to rename the worksheet as unique, may be I can add a counter, so the new worksheet name would be newsheetname1, newsheetname2, etc.

Thanks. I'll try this and will let you know.
 
Upvote 0
Norie,

I tried it- it works fine for the first time, but second time it says "subscript out of range" because it overwirtes "Results" table on the worksheet we exported before this, which was renamed to NewSheetname.

I don't understand why it does that.
Code:
Private Sub cmdExport_Click()
counterwksht = counterwksht + 1
On Error GoTo errorhandler1
Dim strOPFilename As Variant
Dim obj1 As Object
Dim wb As Object
Dim ws As Object
If fIsAppRunning("Excel") Then
Set obj1 = GetObject(, "Excel.Application")
Else
Set obj1 = CreateObject("Excel.Application")
End If
strOPFilename = obj1.GetSaveAsFilename(, "Excel files (*.xls), *.xls", , "Select the file name/location")
If strOPFilename = "" Or strOPFilename = False Then
    MsgBox "Not a valid filename, try again", vbCritical, Prog_TItle
    GoTo errorhandler1
End If
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Results", strOPFilename
Set wb = obj1.Workbooks.Open(strOPFilename)
Set ws = wb.Worksheets("Results")
ws.Name = "sim" & counterwksht
wb.save
wb.Close
Set ws = Nothing
Set wb = Nothing
Set obj1 = Nothing
MsgBox "Results exported to " & strOPFilename & " succesfully!", vbInformation
Exit Sub 'if there is no error exit the sub
errorhandler1:
If Err.Number <> 0 Then
    Dim msg As String
    msg = "Error # " & Str(Err.Number) & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
    MsgBox msg, vbCritical, Prog_TItle & "-Error", Err.HelpFile, Err.HelpContext
End If
Set ws = Nothing
Set wb = Nothing
Set obj1 = Nothing
End Sub
 
Upvote 0
Sorry I don't understand what you mean.

Every time you run the Transferspreadsheet it should create a sheet called Results.
 
Upvote 0
No, it is not creating a new worksheet, it is just overwriting the "Results" worksheet even though we renamed it to something different.
 
Upvote 0
Does the workbook you are exporting to already have a worksheet called Results?
 
Upvote 0

Forum statistics

Threads
1,217,433
Messages
6,136,602
Members
450,021
Latest member
Jlopez0320

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top