We help IT Professionals succeed at work.
Get Started

move and copy worksheet - Macro keeps crashing.....

mikes6058 asked
Last Modified: 2015-09-14
Hi all,

Below is a macro which will move and copy a worksheet from one workbook to another. It will will also copy some of the information from the worksheet to another worksheet in the destination workbook.

However when I run the code the macro is causing excel to crash. I do not receive an error dialogue or message which would indicate it could be an issue with the processing speed???

The data on the sheet has been retrieved from pivot tables etc. using index match and vlookups...

To add when i try to move and copy the worksheet manually I get the same result when my machine crashes.

Could anyone suggest a way to fix this.

Sub ImportForm()
    Dim wbLog As Workbook
    Dim MainSht As Worksheet, LogSht As Worksheet, CopySht As Worksheet
    Dim rData As Range
    Dim NewRw As Long
    Dim sFil As String, sTitle As String, sWb As String
    Dim iFilterIndex As Integer

    Set MainSht = ActiveSheet
    ' Set up list of file filters
    sFil = "Excel Files (*.xl*),*.xl*"
    ' Display *.xls by default
    iFilterIndex = 1
    ' Set the dialog box caption
    sTitle = "Select  File to Zip"
    ' Get the filename
    With Application
        sWb = .GetOpenFilename(sFil, iFilterIndex, sTitle)
        Set wbLog = Workbooks.Open(sWb)
        '        On Error GoTo err_handler
        .ScreenUpdating = False
        .DisplayAlerts = False

        Set LogSht = Worksheets("Member.Meetings.Log")

        MainSht.Copy After:=wbLog.Sheets(wbLog.Sheets.Count)
        ActiveSheet.Name = ActiveSheet.Range("B4").Value
        Set CopySht = ActiveSheet

        Set rData = LogSht.Range("A1").CurrentRegion.Offset(1)
        NewRw = rData.Rows.Count + 1

        NewRw = rData.Rows.Count
        rData.Cells(NewRw, 1).Select
        ActiveSheet.Paste Link:=True
        'company name
        rData.Cells(NewRw, 2).Select
        ActiveSheet.Paste Link:=True
        'date of meeting
        rData.Cells(NewRw, 3).Select
        ActiveSheet.Paste Link:=True
        rData.Cells(NewRw, 4).Select
        ActiveSheet.Paste Link:=True
        'add link
        rData.Cells(NewRw, 5).Select
        LogSht.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                              "'" & CopySht.Name & "'!A1", TextToDisplay:=CopySht.Name


        .ScreenUpdating = True
        .CutCopyMode = False
        .DisplayAlerts = True
    End With

    Exit Sub
    MsgBox "No file selected", vbCritical
    Resume clean_up
End Sub

Open in new window

Watch Question
Consultant (Development Team Lead, Senior Support Engineer, and Technical Test Leader)
This problem has been solved!
Unlock 1 Answer and 2 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE