Excel crashing when I run VBA macro

Question

I have a workbook with a VBA macro that I run every day where I paste a large set of data and it formats, fills in extra fields using a vlookup against hidden sheets, splits the data into individual sheets, and saves each as a CSV file.

This process runs perfectly 6 out 7 days of the week & only has issues when I run Sunday data. All VBA macros within the workbook work fine until I get to the step where it saves the CSVs, then it force closes the excel workbook. I've noticed it saves 1 worksheet (named RCM), but even that it does incorrectly as it only pulls the first row into the file, and the row is from the incorrect sheet.

I thought the issue was with the sheet name (as I have a hidden sheet named RCM1 and the hidden sheets do not get saved). But I've attempted renaming the sheets & am still having the same issue. I'm now uncertain of what is causing Excel to crash only with this particular data.

Here is the save portion of the macro

Sub SaveSheets()
'
' SaveSheets Macro
' Saves sheets as individual CSV files
'

'

Dim csvPath As String
Dim DateName As String
csvPath = "C:\Daily Batch Files"
r = Worksheets("Data").Range("B2")
DateName = "batchredeem.001." & WorksheetFunction.Text(r, "mmmmdd") & "_"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Work").ShowAllData
For Each xWs In ThisWorkbook.Sheets
If xWs.Visible = xlSheetVisible And xWs.Name <> "Magic Buttons" And xWs.Name <> "Data" And xWs.Name <> "Work" Then
            xWs.Copy
            Application.ActiveWorkbook.SaveAs Filename:=csvPath & "\" & DateName & xWs.Name & ".csv", FileFormat:=xlCSV
            Application.ActiveWorkbook.Close False
        ElseIf xWs.Name = "Work" Then
            xWs.Copy
            Application.ActiveWorkbook.SaveAs Filename:=csvPath & "\" & xWs.Name & ".csv", FileFormat:=xlCSV
            Application.ActiveWorkbook.Close False
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

**EDIT to add additional info: If I change the name of the sheet before running the macro, it won't save the renamed "RCM" sheet at all- it works for the previous sheet, however, and if I delete the "RCM" sheet, the entire macro runs normally.

Answer 1

Export Worksheets As One-Worksheet Files

Option Explicit

Sub ExportVisibleWorksheets()
' Saves worksheets as individual CSV files

    ' Source
    Const sExceptionsList As String = "Magic Buttons,Work,Data"
    Const sSpecialName As String = "Work" ' exported differently
    ' Source Lookup
    Const slName As String = "Data" ' included in the exceptions list
    Const slCellAddress As String = "B2"
    ' Destination
    Const dDateLeft As String = "batchredeem.001."
    Const dDateMidFormat As String = "mmmmdd"
    Const dDateRight As String = "_"
    Dim dFolderPath As String: dFolderPath = "C:\Daily Batch Files\"
    ' The following two depend on each other!
    Dim dFileExtension As String: dFileExtension = ".csv"
    Dim dFileFormat As XlFileFormat: dFileFormat = xlCSV
    
    If Right(dFolderPath, 1) <> "\" Then dFolderPath = dFolderPath & "\"
    If Len(Dir(dFolderPath, vbDirectory)) = 0 Then Exit Sub ' doesn't exist
    
    If Left(dFileExtension, 1) <> "." Then dFileExtension = "." & dFileExtension
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = swb.Worksheets(slName)
    Dim sCell As Range: Set sCell = sws.Range(slCellAddress)
    
    Dim sExceptions() As String: sExceptions = Split(sExceptionsList, ",")
    Dim dDateMid As String
    dDateMid = WorksheetFunction.Text(sCell.Value, dDateMidFormat) ' English
    'dDateMid = Format(sCell.Value, dDateMidFormat) ' International
    Dim dDateName As String: dDateName = dDateLeft & dDateMid & dDateRight
    
    Application.ScreenUpdating = False
    
    Dim dwb As Workbook
    Dim dFilePath As String
    Dim dwsCount As Long
    Dim ErrNum As Long
    Dim DoNotCopy As Boolean
    
    For Each sws In swb.Worksheets
        
        If sws.Visible = xlSheetVisible Then
            
            If IsError(Application.Match(sws.Name, sExceptions, 0)) Then
                dFilePath = dFolderPath & dDateName & sws.Name & dFileExtension
            ElseIf StrComp(sws.Name, sSpecialName, vbTextCompare) = 0 Then
                dFilePath = dFolderPath & sws.Name & dFileExtension
                If sws.AutoFilterMode Then
                    sws.ShowAllData
                End If
            Else
                DoNotCopy = True
            End If
            
            If DoNotCopy Then
                DoNotCopy = False
            Else
                sws.Copy
                Set dwb = Workbooks(Workbooks.Count)
                Application.DisplayAlerts = False ' overwrite: no confirmation
                On Error Resume Next ' prevent error if file is open
                    dwb.SaveAs Filename:=dFilePath, FileFormat:=dFileFormat
                    ErrNum = Err.Number
                On Error GoTo 0
                Application.DisplayAlerts = True
                dwb.Close SaveChanges:=False
                If ErrNum = 0 Then
                    dwsCount = dwsCount + 1
                Else
                    ErrNum = 0
                End If
            End If
        
        End If
    
    Next
    
    Application.ScreenUpdating = True

    Select Case dwsCount
        Case 0: MsgBox "No worksheets exported.", vbExclamation
        Case 1: MsgBox "One visible worksheet exported.", vbInformation
        Case Else
            MsgBox dwsCount & " visible worksheets exported.", vbInformation
    End Select

End Sub