Excel crashing when I run VBA macro - excel

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.
***EDIT 2 - I also cannot manually "copy" the "RCM" sheet, but I can manually copy any of the others. Also, if I save the entire workbook, then run the macro, it works normally! I'm stumped & not sure why it isn't working just for this one worksheet.

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