Hi there,

This procedure works fine when I step through with F8, but it crashes Excel when I try to run it. I have simplified the macro for the purposes of posting it. It is intended to create a new workbook with a sheet called "Facility Prep Detail," and a folder on the user's desktop to save it to. It should copy an existing "Facility" sheet from the blank template to the new book. Then, it should filter data in another workbook and copy the visible data only to the Facility Prep Detail sheet in the new book. Finally it should save the file to the new folder and display a message saying that this has been done.

The data set that is being filtered (named range "PrepRawData") is very large so my only guess is that this is the cause. I understand that Special Cells has been known for its size limitation but that this was fixed for Excel 2010, which I am using. None of this explains why the macro works great iteratively. I know parts of it could be cleaner but I just want to get it running.

Thank you in advance!

Sub CreatePrepDetailSaveAs7()
    
    Dim objFCwb As Workbook
    Dim objFCsht As Worksheet
    Dim user As String
    Dim num As Integer
    Dim weekbeginFilter As Date
    Dim FC As String
        
    weekbeginFilter = Date + (7 - Weekday(Date, vbMonday)) - 14
    user = Environ("username")
    num = Application.WorksheetFunction.WeekNum(Date) - 1
    FC = "facility"
    MkDir ("C:\Users\" & user & "\Desktop\FC_Feedback_Week_" & num)
    Application.DisplayAlerts = False

    Set objFCwb = Workbooks.Add
    Set objFCsht = objFCwb.Worksheets.Add
    objFCsht.Name = FC & "_Prep_Detail"
    Workbooks("Blank Template with Macros.xlsm").Worksheets(FC).Copy Before:=objFCwb.Sheets(FC & "_Prep_Detail")

    Workbooks("FC Weekly Feedback Raw Data.xlsx").Activate
    Worksheets("PrepRawData").Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    
    With ActiveSheet.Range("PrepRawData")
        .AutoFilter Field:=2, Operator:=xlFilterValues, Criteria1:=Array(2, weekbeginFilter)
        .AutoFilter Field:=10, Operator:=xlFilterValues, Criteria1:=Array(10, FC)
    End With
    
    Range("PrepRawData").SpecialCells(xlCellTypeVisible).Copy Destination:=objFCwb.Worksheets(FC & "_Prep_Detail").Range("A1")
    With objFCwb
       .Worksheets("Sheet1").Delete
       .Worksheets("Sheet2").Delete
       .Worksheets("Sheet3").Delete
       .SaveAs Filename:="C:\Users\" & user & "\Desktop\FC_Feedback_Week_" & num & "\" & FC & "_Week_" & num, FileFormat:=xlOpenXMLWorkbook
       .Close
    End With
    
    Application.DisplayAlerts = True
    MsgBox ("The files have been saved to your desktop in " & vbNewLine & "a new folder called FC_Feedback_Week_" & num & ".")
    Application.DisplayAlerts = False
    'Workbooks("Blank Template with Macros.xlsm").Close
    Application.DisplayAlerts = True

End Sub