Try in a standard module...

Option Explicit

Sub SheetSaver2() 'Working in 97-2013
'Copy every sheet from the workbook with this macro
Dim sFileExt$, sDate$, sFolder$
Dim lFileFormat&, lCalcMode&
Dim wkbSource As Workbook, wkbTarget As Workbook
Dim wks, wksTarget As Worksheet

'Create new folder to save the new files in
sDate = Format(Now, "dd-mm-yyyy_hhmmss")
Set wkbSource = ActiveWorkbook
'sFolder = wkbSource.Path & "\" & wkbSource.Name & " " & sDate
sFolder = wkbSource.Path & "\" _
& "Reconlite_Input_Files_" & sDate
If Dir$(sFolder & "\nul") = "" Then MkDir sFolder

With Application
.ScreenUpdating = False: .EnableEvents = False
lCalcMode = .Calculation: .Calculation = xlCalculationManual
End With
On Error GoTo ErrExit

For Each wks In wkbSource.Worksheets
'Copy every visible sheet to a new workbook
If wks.Visible Then
'Set fully qualified refs to the new worksheet/workbook
wks.Copy: Set wksTarget = ActiveSheet
Set wkbTarget = wksTarget.Parent

'Determine the Excel version and file extension/format
If Val(Application.Version) < 12 Then 'Excel 97-2003
sFileExt = ".xls": lFileFormat = -4143
Else 'Excel 2007 and later
'================================================= =====
'At this point wkbTarget has not been named,
'NOR would XL assign the same name as an open file,
'NOR would XL open 2 files with same name.
'Actual name should be "Book#" and so the following
'makes absolutely no sense!
' If wkbSource.Name = .Name Then
' MsgBox "Your answer is NO in the security"
'' Dialog "" '???what is this???
' GoTo GoToNextSheet
' Else
'================================================= =====
Select Case wkbSource.FileFormat
Case 51: sFileExt = ".xlsx": lFileFormat = 51
Case 52:
If wkbTarget.HasVBProject Then
sFileExt = ".xlsm": lFileFormat = 52
Else
sFileExt = ".xlsx": lFileFormat = 51
End If
Case 56: sFileExt = ".xls": lFileFormat = 56
Case Else: sFileExt = ".xlsb": lFileFormat = 50
End Select
'================================================= =====
' End If
'================================================= =====
End If 'Val(Application.Version) < 12

With wksTarget
.Name = "Data"
'Change cell contents to values
If Not .ProtectContents Then
.UsedRange.Value = .UsedRange.Value
End If
End With 'wksTarget

'Save the new workbook and close it
With wkbTarget
.SaveAs sFolder & "\" & wksTarget.Name _
& Format(Now - 30, "mmyyyy") & sFileExt, _
FileFormat:=lFileFormat
.Close True
End With 'wkbTarget

End If 'wks.Visible
'================================================= =====
'GoToNextSheet:
'================================================= =====
Next 'wks
wkbSource.Close

ErrExit:
'Restore Application settings
With Application
.ScreenUpdating = True: .EnableEvents = True
.Calculation = lCalcMode
End With 'Application

'Release memory reserved for objects created
Set wkbSource = Nothing: Set wkbTarget = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion