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
 

Some videos you may like

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,207
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
 

Watch MrExcel Video

Forum statistics

Threads
1,095,375
Messages
5,444,096
Members
405,266
Latest member
Ryokaki

This Week's Hot Topics

Top