title: Copy Worksheets break links
body: <p>I have the below 2 subs in VBA which perform 2 different but similar tasks. One allows you to selects sheets from a Workbook using a checkbox popup and then copies these sheets into a new blank Workbook. The other allows you to manually populate a list of names of the sheets you want to copy (i.e. setup a "batch" of sorts) on a sheet and then copy all the sheets across into a new blank Workbook in a similar fashion to the first.</p>
  
  <p>The problem I am having is - with the first sub I am able to break links after copying into the new Workbook, but with the second sub I am not able to break links. I think it has to do with a number of defined names within the original Workbook, as if you "Move or Copy/Create a Copy" manually, you are able to break the links.</p>
  
  <p>Is there any code I can add to the below (onto both subs if possible) which will automatically break all links in the new Workbook to the old one? Or at least, is it possible to amend the second sub so that it copies across in a similar fashion to the first one which will then allow me to break links manually?</p>
  
  <pre><code>Sub CopySelectedSheets()
  
  '1. Declare variables
  Dim I As Integer
  Dim SheetCount As Integer
  Dim TopPos As Integer
  Dim lngCheckBoxes As Long, y As Long
  Dim intTopPos As Integer, intSheetCount As Integer
  Dim intHor As Integer       
  Dim intWidth As Integer     
  Dim intLBLeft As Integer, intLBTop As Integer, intLBHeight As Integer
  Dim Printdlg As DialogSheet
  Dim CurrentSheet As Worksheet, wsStartSheet As Worksheet
  Dim CB As CheckBox
  Dim firstSelected As Boolean
  
  '    Dim wb As Workbook
  '    Dim wbNew As Workbook
  '    Set wb = ThisWorkbook
  '    Workbooks.Add ' Open a new workbook
  '    Set wbNew = ActiveWorkbook
  
  On Error Resume Next
  Application.ScreenUpdating = False
  
  '2. Check for protected workbook
  If ActiveWorkbook.ProtectStructure Then
      MsgBox "Workbook is protected.", vbCritical
      Exit Sub
  End If
  
  '3. Add a temporary dialog sheet
  Set CurrentSheet = ActiveSheet
  Set wsStartSheet = ActiveSheet
  Set Printdlg = ActiveWorkbook.DialogSheets.Add
  
  SheetCount = 0
  
  '4. Add the checkboxes
  TopPos = 40
  For I = 1 To ActiveWorkbook.Worksheets.Count
      Set CurrentSheet = ActiveWorkbook.Worksheets(I)
      'Skip empty sheets and hidden sheets
      If Application.CountA(CurrentSheet.Cells) &lt;&gt; 0 And _
          CurrentSheet.Visible Then
          SheetCount = SheetCount + 1
          Printdlg.CheckBoxes.Add 78, TopPos, 150, 16.5
              Printdlg.CheckBoxes(SheetCount).Text = _
                  CurrentSheet.Name
          TopPos = TopPos + 13
      End If
  Next I
  
  '6. Move the OK and Cancel buttons
  Printdlg.Buttons.Left = 240
  
  '7. Set dialog height, width, and caption
  With Printdlg.DialogFrame
      .Height = Application.Max _
          (68, Printdlg.DialogFrame.Top + TopPos - 34)
      .Width = 230
      .Caption = "Select sheets to generate"
  
  End With
  
  'Change tab order of OK and Cancel buttons
  'so the 1st option button will have the focus
  Printdlg.Buttons("Button 2").BringToFront
  Printdlg.Buttons("Button 3").BringToFront
  
  '9. Display the dialog box
  CurrentSheet.Activate
  wsStartSheet.Activate
  Application.ScreenUpdating = True
  If SheetCount &lt;&gt; 0 Then
  
  
          If Printdlg.Show Then
                  For Each CB In Printdlg.CheckBoxes
  
                      If CB.Value = xlOn Then
                          If firstSelected Then
                              Worksheets(CB.Caption).Select Replace:=False
                      Else
                          Worksheets(CB.Caption).Select
                          firstSelected = True
                      End If
  
                      'For y = 1 To ActiveWorkbook.Worksheets.Count
                          'If WorksheetFunction.IsNumber _
                          '(InStr(1, "ActiveWorkbook.Sheets(y)", "Contents")) = True Then
                              'CB.y = xlOn
                          'End If
                      End If
  
                  Next
  
  
                  ActiveWindow.SelectedSheets.Copy
  
          Else
              MsgBox "No worksheets selected"
  
  
          End If
  
  End If
  
  '   Delete temporary dialog sheet (without a warning)
  ''    Application.DisplayAlerts = False
  ''    Printdlg.Delete
  
  '   Reactivate original sheet
  ''    CurrentSheet.Activate
  ''    wsStartSheet.Activate
  
  '10.Delete temporary dialog sheet (without a warning)
  Application.DisplayAlerts = False
  Printdlg.Delete
  
  '11.Reactivate original sheet
  CurrentSheet.Activate
  wsStartSheet.Activate
  Application.DisplayAlerts = True
  
  End Sub
  
  Sub CopySpecificSheets()
  
  '1. Declare Variables
  Dim myArray() As String
  Dim myRange As Range
  Dim Cell As Range
  Dim OldBook As String
  Dim newBook As String
  Dim a As Long
  
  '2. Set Range of Lookup
  Set myRange = Sheets("Report Batch").Range("A2:A40")
  
  OldBook = ActiveWorkbook.Name
  
  '3. Generate Array of Sheet Names removing Blanks
  For Each Cell In myRange
  If Not Cell = "" Then
      a = a + 1
      ReDim Preserve myArray(1 To a)
      myArray(a) = Cell
  End If
  Next
  
  '4. Copy Array of Sheets to new Workbook
  For a = 1 To UBound(myArray)
  If a = 1 Then
      Sheets(myArray(a)).Copy
      newBook = ActiveWorkbook.Name
      Workbooks(OldBook).Activate
  Else
      Sheets(myArray(a)).Copy After:=Workbooks(newBook).Sheets(a - 1)
      Workbooks(OldBook).Activate
  End If
  Next
  End Sub
  </code></pre>