VBA Excel crashes on ThisWorkbook.Sheets.Copy

alekks

New Member
Joined
Jan 24, 2019
Messages
1
Hi,

I've got a macro that basically does the following:

  1. Opens data source files, that remain open (aprox. 8 files)
  2. Get a key from a list for filtering out data in the source files
  3. Copies result for and pastes in corresponding sheet in macro file
  4. Refreshes pivot tables and charts to export images of charts etc (later to be used in email)
  5. Copies the sheets to a new workbook, deletes/hides some unnecessary sheets and saves this new non-macro workbook
  6. Repeat step 2, use next key etc
  7. Close all source files

The amount of data aren't very massive. Some reports can have a couple of sheets with 4k rows * 8 cols. But normal amounts are about 250-500 rows * 8 cols. There is a Summary, dashboard style with some slicers and charts. Some SUMIFS etc. This is what I suspect is the culprit.


The problem I have is that when running ThisWorkbook.Sheets.Copy excel crashes. Sometimes on first loop, sometimes after 5 runs.
It works quite good if I put a Stop just before or after the .Copy but now it have started failing anyway as if things getting worse. Haven't been any problems stepping through (F8) the macro. So my thought is that even though the data isn't massive, something seem to be heavy... So I'm looking for help, either to see if I'm doing something I shouldn't in the code or, to use another approach to achieve the same thing.


The requirements are that the macro file must remain open since it need to loop through more keys to create more reports. Everything works fine except to create the macro free workbook.

Ideas?



Code:
Sub saveReport(sFullPath As String)    

    Dim WbkSrc As Workbook
    
    ' Set Application Properties - these have been tried True to see if there's any errors or anything - but nothing.
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    ' Set Source Workbook
    Set WbkSrc = ThisWorkbook
    
    'Save As new .xlsx file
    'Deletes old file with same name if it exists (if the report is created several times same day for some reason)
    If Dir(sFullPath, vbDirectory) <> "" Then
        Kill (sFullPath)
    End If
    

    ' Copies all sheets into new workbook - here does the report fail. Sometimes work if I set a Stop here or after and just hits F5 to run again - as if Excel gets some breathing room. Also tried DoEvents with no result.
    WbkSrc.Sheets.Copy
    
    ' Save as macro free workbook in report week's directory (sFullPath is set outside this Sub using ThisWorkbook.Path) since it works sometimes it shouldn't be a problem with the path.
    ActiveWorkbook.SaveAs Filename:=sFullPath, FileFormat:=51
    

    ' Delete and hide Worksheets in New macro free Workbook
    ActiveWorkbook.Sheets("Create Report").Delete
    ActiveWorkbook.Sheets("Assets").Visible = xlSheetVeryHidden
    ActiveWorkbook.Sheets("Data1").Visible = xlSheetVeryHidden
    If Len(ActiveWorkbook.Sheets("Data2").Range("A2").Value) = 0 Then
        ActiveWorkbook.Sheets("Data2").Visible = xlSheetVeryHidden
    End If
    If Len(ActiveWorkbook.Sheets("Data3").Range("A2").Value) = 0 Then
        ActiveWorkbook.Sheets("Data3").Visible = xlSheetVeryHidden
    End If
    If Len(ActiveWorkbook.Sheets("Data4").Range("A2").Value) = 0 Then
        ActiveWorkbook.Sheets("Data4").Visible = xlSheetVeryHidden
    End If
    If Len(ActiveWorkbook.Sheets("Data5").Range("A2").Value) = 0 Then
        ActiveWorkbook.Sheets("Data5").Visible = xlSheetVeryHidden
    End If
    If Len(ActiveWorkbook.Sheets("Data6").Range("A2").Value) = 0 Then
        ActiveWorkbook.Sheets("Data6").Visible = xlSheetVeryHidden
    End If

    ' Save changes & Close New Workbbok
    ActiveWorkbook.Close SaveChanges:=True
    
    
    WbkSrc.Activate
    
    ' Set Application Properties
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

Thanks a bunch!
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
What do you mean - completely shuts down? No error message or anything?

Have you tried to create the workbook first and then copy the sheets in it?
Maybe this will give excel some breathing space.
Then just delete the original sheets in the new workbook. In this way you will also have more control over the new WB object then just relying on the ActiveWorkbook.
You can also disable calculations in both workbooks during Copy (Application.Calculation=xlCalculationManual)
And better keep alerts on at least while the problem is solved.

I don't think there will be difference in the behavior of worksheets.copy but you can also try this.
And one more thing: you are transferring sheets, but all you code stored in modules remains behind - this may also result in too many errors at once if you have used some user defined functions (especially if calculations ar automatic)
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,239
Members
452,621
Latest member
Laura_PinksBTHFT

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
Back
Top