VikingScript
New Member
- Joined
- May 20, 2022
- Messages
- 1
- Office Version
- 365
- Platform
- Windows
- MacOS
I have a sheet that is a simple form and on this sheet are two buttons, one button "Save Files" automatically creates a folder using 4 cell values and then copies the sheet as a xlsx file and a pdf file naming the documents the same as the folder. The issue I'm having is the xlsx copies are losing the data validations and the formulas in cells "E57:E60" are referencing the source sheet instead of just staying within the copied sheet. Here is what I have so far.
VBA Code:
Private Function mySaveCopyAs(pWorkbookToBeSaved As Workbook, pNewFileName As String, pFileFormat As XlFileFormat) As Boolean
'returns false on errors
On Error GoTo errHandler
If pFileFormat = xlOpenXMLWorkbookMacroEnabled Then
'no macros can be saved on this
mySaveCopyAs = False
Exit Function
End If
'create new workbook
Dim mSaveWorkbook As Workbook
Set mSaveWorkbook = Workbooks.Add
Dim initialSheets As Integer
initialSheets = mSaveWorkbook.Sheets.Count
'note: sheet names will be 'Sheet1 (2)' in copy otherwise if
'they are not renamed
Dim sheetNames() As String
Dim activeSheetIndex As Integer
activeSheetIndex = pWorkbookToBeSaved.ActiveSheet.Index
Dim i As Integer
'copy each sheet
For i = 1 To pWorkbookToBeSaved.Sheets.Count
pWorkbookToBeSaved.Sheets(i).Copy After:=mSaveWorkbook.Sheets(mSaveWorkbook.Sheets.Count)
ReDim Preserve sheetNames(1 To i) As String
sheetNames(i) = pWorkbookToBeSaved.Sheets(i).Name
Next i
'clear sheets from new workbook
Dim shp As Shape
For Each shp In mSaveWorkbook.Sheets("Form").Shapes
If shp.Type = msoFormControl Then shp.Delete
Next shp
Application.DisplayAlerts = False
For i = 1 To initialSheets
mSaveWorkbook.Sheets(1).Delete
Next i
'rename stuff
For i = 1 To UBound(sheetNames)
mSaveWorkbook.Sheets(i).Name = sheetNames(i)
Next i
'reset view
mSaveWorkbook.Sheets(activeSheetIndex).Activate
'save and close
mSaveWorkbook.SaveAs FileName:=pNewFileName, FileFormat:=pFileFormat, CreateBackup:=False
mSaveWorkbook.Close
mySaveCopyAs = True
Application.DisplayAlerts = True
Exit Function
errHandler:
'whatever else you want to do with error handling
mySaveCopyAs = False
Exit Function
End Function