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

[slycmdo13]

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

 

[John_w]

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.

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

 

[alishern]

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

 

[John_w]

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.