writing a macro to copy an entire xlsm workbook to a users desktop as xlsx values only.

[PTEOMARK]

Ok, so I have a bunch of excel workbooks, located in SharePoint, that are full of lookups etc and I want to write a macro that I can place in each that will:

1. Save the xlsm workbook before anything is done
2. Remove any worksheet protection on all sheets (same passcode on all 9999)
3. Copy everything
4. make a new workbook
5. Using the same filename as the original but with the word 'VALUES' + date and time amended (ie 'workbook name'_VALUES_DDMMYY_HHMMSS)
6. Save it to the users desktop as XLSX
7. Re-protect on all sheets in original workbook (same passcode on all 9999)
8. Close the original workbook (new workbook can stay open)

So far I have mashed up a few different examples found here and have the following code. Unfortunately this is NOT saving the file correctly.
The output is being saved as "DesktopBOM Values Only15072024154934.xlsx" into the users H:/ drive not to the desktop, its CLOSE to working.
I did almost get the save to work, it saved to desktop but the naming was 'original filename'.xlsmDDMMYYHHMMSS.xlsx"

Sub BOM Values Only()
Dim SavePath As String
Dim sh As Worksheet
Dim reopenWB as String
Dim calcMode As XlCalculation

'section start: remove protection
Dim wSheet As Worksheet
Dim Pwd As String
Pwd = 9999
On Error Resume Next
For Each wSheet In Worksheets
wSheet.Unprotect Password:=9999
Next wSheet
'section end: remove protection

‘SavePath = ThisWorkbook.Path & "\"
SavePath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
reopenWB = Thisworkbook.FullName

With Application
calcMode = .Calculation
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

'save copy workbook as backup, just in case!
‘ThisWorkbook.SaveCopyAs SavePath & "Master_backup.xlsm"
ThisWorkbook.Save ' save just because belt n braces

'loop through sheets and set the used range to values
For Each sh In ThisWorkbook.Worksheets
With sh.UsedRange
.Value = .Value
End With
Next sh

'save as xlsx to remove macros
ThisWorkbook.SaveAs SavePath & "BOM Values Only" & Format(Now, "ddmmyyyyhhmmss"), xlOpenXMLWorkbook
'reopen the original file
Workbooks.Open (reopenWB)
'close the flat file
ThisWorkbook.Close False

With Application
.Calculation = calcMode
.DisplayAlerts = True
.ScreenUpdating = True
End With

 End Sub

 

[PTEOMARK]

EDIT:
I have just realised that this code is also converting the original workbook to values only. and that is not a good thing - I need original workbook to stay as it is.

 

[PTEOMARK]

OK, have got things working really well, now the only thing I want to add is the date to the end of the filename it is saved as

    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sFile = sourceworkbook.Name
    sourceworkbook.SaveAs Filename:=sPath & "\" & sFile

Working Code:

Sub SaveSourceWorkbook2Desktop()
    Dim sPath As String
    Dim sFile As String
    Dim sourceworkbook As Workbook
    Set sourceworkbook = Workbooks.Open("https://COMPANYNAME.sharepoint.com/:x:/r/sites/msteams_31f632/Shared%20Documents/Bill%20of%20Materials%20Templates%20(%20BOM%27s)/Assembly/CUSTOMERNAME%20Dashboard%20TESTFILE.xlsx")

    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    sFile = sourceworkbook.Name
    sourceworkbook.SaveAs Filename:=sPath & "\" & sFile
    
'remove protection in NEW workbook
    Dim wSheet As Worksheet
    Dim Pwd As String
    Pwd = 9999
    On Error Resume Next
    For Each wSheet In Worksheets
    wSheet.Unprotect Password:=9999
    Next wSheet
    
'convert to values only
    For Each ws In Worksheets
    other = ws.Name
    Worksheets(other).Activate
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=True, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Next ws


'Saveworkbook
    ActiveWorkbook.Save

    
End Sub

 

[Alex Blakenburg]

You've done the hard part .
This should work:
(replaces the line > sFile = sourceworkbook.Name

    sFile = Replace(sourceworkbook.Name, ".xls", " " & Format(Date, "yyyymmdd") & ".xls")

Replace the " " with whatever spacer you want ie if your prefer underscore then "_"
Replace the format with your preferred format ie prefer yyyymmdd because then the files sort correctly.

 

[jolivanes]

By the looks of it, you could combine the removing of passwords and converting to values into one like so.
"Dim ws As Worksheet" after the "Dim sFile As String" line. Keep all the dimensioning together instead of spread throughout the code.

For Each ws in ActiveWorkbook.Worksheets
With ws
.Unprotect Password:=9999
.UsedRange.Value = .UsedRange.Value
End With
Next ws

 

[PTEOMARK]

You've done the hard part .
This should work:
(replaces the line > sFile = sourceworkbook.Name

    sFile = Replace(sourceworkbook.Name, ".xls", " " & Format(Date, "yyyymmdd") & ".xls")

Replace the " " with whatever spacer you want ie if your prefer underscore then "_"
Replace the format with your preferred format ie prefer yyyymmdd because then the files sort correctly.

THANK YOU!!!!

 

[PTEOMARK]

By the looks of it, you could combine the removing of passwords and converting to values into one like so.
"Dim ws As Worksheet" after the "Dim sFile As String" line. Keep all the dimensioning together instead of spread throughout the code.

For Each ws in ActiveWorkbook.Worksheets
With ws
.Unprotect Password:=9999
.UsedRange.Value = .UsedRange.Value
End With
Next ws

Thanks, that looks much tidier - I had split it all down to individual steps to try and solve each part one at a time, now its time to reduce it down?

 

[smozgur]

@PTEOMARK - I have changed the solution post with #3 (your own solution). In your future question, please mark the post as the solution that contains the answer (even it is your own answer) as it will help other members who might be looking for this solution.

 

[PTEOMARK]

I may have got most of it figured it out, but Alex solved the last key peice - and provided the best instruction/code on the file naming that i have seen. That line of code can be used in so many different ways its awesome.

 

[Alex Blakenburg]

That's very nice feedback. Thank you.