Copying worksheets to another workbook

brianfosterblack

Active Member
Joined
Nov 1, 2011
Messages
251
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
VBA Code:
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
VBA Code:
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.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,589
Office Version
  1. 2013
Platform
  1. Windows
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.

VBA Code:
'  === 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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,151,857
Messages
5,766,792
Members
425,379
Latest member
thedoctor00

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
Top