Copying worksheets to another workbook

[brianfosterblack]

I have 2 workbooks which are identical. Same layout, same named ranges and same macros. These are used by 2 staff members. Lets say staff member 1 uses workbook 1 and staff member 2 uses workbook 2
If staff member 1 gets a new client he adds a new sheet to his workbook for that client (New Client) and starts entering details about the client. After some time he decides the client must rather be served by staff member 2 so he wants to copy the worksheet over to workbook 2 of staff member 2.
This is the code I am using to transfer the workbook and remove any hyperlinks. Both workbooks are placed in the same directory to do this.
Code in the Module

Public Sub CopySheetToEndAnotherWorkbook()
    Load FrmCopySheet
    FrmCopySheet.Show
 
    If (FrmCopySheet.SelectedWorkbook <> "") Then
        ActiveSheet.Copy After:=Workbooks( _
        FrmCopySheet.SelectedWorkbook).Sheets( _
        Workbooks(FrmCopySheet.SelectedWorkbook). _
        Worksheets.Count)
    End If
 
    Unload FrmCopySheet
    On Error Resume Next 'Trap error

    For i = 1 To UBound(ar) 'Excel VBA loop throuh links
    ActiveWorkbook.BreakLink ar(i), xlLinkTypeExcelLinks
    Next i

    On Error GoTo 0
End Sub

Code in the userform

Public SelectedWorkbook As String
 
Private Sub UserForm_Initialize()
    SelectedWorkbook = ""
    ListBox1.Clear
    For Each wbk In Application.Workbooks
        ListBox1.AddItem (wbk.Name)
    Next
End Sub
 
Private Sub CommandButton1_Click()
    If ListBox1.ListIndex > -1 Then
        SelectedWorkbook = ListBox1.List(ListBox1.ListIndex)
    End If
    Me.Hide
End Sub
 
Private Sub CommandButton2_Click()
    SelectedWorkbook = ""
    Me.Hide
End Sub

The worksheet transfers perfectly and everything seems fine at first.
The problem I am having is that when I then run a macro in Workbook 1 it seems to be linking to workbook 2 in some way. I am assuming this as the macro takes very long and sometimes freezes. Also if I close workbook 2 and open it again it tells me I have links to external sources. When I check the "Clear" menu item on Workbook 2, I see no hyperlinks. Can anyone help me with this and explain what is happening.

 

[GWteB]

The links in your workbook you're talking about are NOT removed or broken. The code isn't right. You could have been warned but since error handling is turned off, you weren't. Your comment within the code says: "Trap error", but actually errors are ignored this way.
I modified the code and I think it works as you intended. However, a not unimportant remark should be made here. The links are created when there are references to other worksheets in the original workbook. That can be references within formulas, whether or not through named ranges. Those references do not automatically redirect to the new target workbook. If they are not broken, then the behavior you are talking about arises. If they are broken, the formula disappears in its entirety, leaving only the value behind. If that is intended, than that would be okay.

Note that I have added extra declarations in the form of specific object variables, namely of type Workbook. That way, you're more likely to avoid run-time errors. The code is also slightly more readable.
Hopefully this is of some help.

'  === userform code-behind module ====

Private SelectedWorkbook As String
Public TargetWorkbook As Workbook       ' <<<<<<<<<<< added
 
Private Sub UserForm_Initialize()
    SelectedWorkbook = ""
    ListBox1.Clear
    For Each wbk In Application.Workbooks
        ListBox1.AddItem (wbk.Name)
    Next
End Sub
 
Private Sub CommandButton1_Click()
    If ListBox1.ListIndex > -1 Then
        SelectedWorkbook = ListBox1.List(ListBox1.ListIndex)
        Set TargetWorkbook = Application.Workbooks(SelectedWorkbook)
    End If
    Me.Hide
End Sub
 
Private Sub CommandButton2_Click()
    SelectedWorkbook = ""
    Set TargetWorkbook = Nothing
    Me.Hide
End Sub


'  === standard module ====

Public Sub CopySheetToEndAnotherWorkbook()
    Dim TargetWb    As Workbook         ' <<<<<<<<<<< added
    Dim Link        As Variant          ' <<<<<<<<<<< added

    Load FrmCopySheet
    FrmCopySheet.Show

    Set TargetWb = FrmCopySheet.TargetWorkbook
    If Not TargetWb Is Nothing Then
        ActiveSheet.Copy After:=TargetWb.Sheets(TargetWb.Worksheets.Count)

        For Each Link In TargetWb.LinkSources(Type:=xlLinkTypeExcelLinks)
            TargetWb.BreakLink Name:=Link, Type:=xlLinkTypeExcelLinks
        Next Link
    End If

    Unload FrmCopySheet
End Sub