Copy worksheets to new workbook, delete connections, then save new workbook

slycmdo13

New Member
Joined
Nov 3, 2019
Messages
1
I am trying to copy two worksheets to a new workbook and rename/save that new workbook.

When I copy the worksheets over - the queries are copying with it...which is causing issues when I try to save the new workbook. To get around this, I am having to delete the queries / connections...then save it. In the code below, it is deleting the queries and connections in both worksheets and saving both worksheets. I don't want to delete queries in the 'source' workbook...only the new workbook. (or not copy them at all!)

Prive Sub NewBook()

With ActiveWorkbook
Dim FileName As String
FileName = [insert_file_name]

Dim cn As WorkbookConnection
Dim qr As WorkbookQuery
On Error Resume Next
For Each cn In ThisWorkbook.Connections
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
This macro copies the two worksheets named "Sheet1" and "Sheet2" to a new workbook and then deletes workbook connections, workbook queries and Excel links in the new workbook. The new workbook is saved in the same folder as the macro workbook and named as shown in the code.

Code:
Public Sub Copy_Worksheets_Delete_Connections()
    
    Dim newWb As Workbook
    Dim wbConn As WorkbookConnection
    Dim wbQuery As WorkbookQuery
    Dim links As Variant, i As Long
    
    ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2")).Copy
    Set newWb = ActiveWorkbook
    
    'Delete workbook connections
    
    For Each wbConn In newWb.Connections
        wbConn.Delete
    Next
    
    'Delete workbook queries
    
    For Each wbQuery In newWb.Queries
        wbQuery.Delete
    Next
    
    'Delete Excel links
    
    links = newWb.LinkSources(xlExcelLinks)
    If links <> Empty Then
        For i = 1 To UBound(links)
            newWb.BreakLink links(i), xlLinkTypeExcelLinks
        Next
    End If
    
    Application.DisplayAlerts = False 'suppress warning message displayed if new workbook already exists
    newWb.SaveAs ThisWorkbook.Path & "\New_Workbook_with_2_Sheets.xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    newWb.Close False
    
End Sub
 
Upvote 0
Hello,

How do i place a button that activates the code and perform creation of a new workbook out of it? I assigned the code to a Form Controls Button and made a few changes to the code (below). It is saying there is bug in the code for deleting the button. Please help. Thanks

My changes are:
* Added a date stamp to the file name
* Declared the button and added code to remove the button before creating a new workbook

I have to have the button removed in the new workbook as it will be an .xlsx file.

Public Sub ExportNewUpdate_Rev()

Dim newWb As Workbook
Dim wbConn As WorkbookConnection
Dim wbQuery As WorkbookQuery
Dim links As Variant, i As Long
Dim xStrDate As String
Dim btn As Shape

Application.ScreenUpdating = False

xStrDate = Format(Now, "yyyymmdd_HH-mm")

ThisWorkbook.Worksheets(Array("ESTIMATES_ROLLUP")).Copy
Set newWb = ActiveWorkbook

'Delete workbook connections

For Each wbConn In newWb.Connections
wbConn.Delete
Next


'Delete workbook queries

For Each wbQuery In newWb.Queries
wbQuery.Delete
Next


'Delete workbook button

For Each btn In newWb.Shapes
btn.Delete
Next

links = newWb.LinkSources(xlExcelLinks)
If links <> Empty Then
For i = 1 To UBound(links)
newWb.BreakLink links(i), xlLinkTypeExcelLinks
Next
End If


Application.DisplayAlerts = False 'suppress warning message displayed if new workbook already exists
newWb.SaveAs ThisWorkbook.Path & "\PE Rollup Report " & " " & xStrDate & ".xlsx"
Application.DisplayAlerts = True

newWb.Close False

MsgBox ("Your new report has been exported to the same location with filename: " & "PE Rollup Report " & " " & xStrDate & ".xlsx")

Application.ScreenUpdating = True


End Sub
 
Upvote 0
How do i place a button that activates the code and perform creation of a new workbook out of it? I assigned the code to a Form Controls Button and made a few changes to the code (below). It is saying there is bug in the code for deleting the button. Please help. Thanks
Please start a new thread.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,543
Latest member
MartinLarkin

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