VBA Stuck Sanitising Several Sheets

Tarkemelion

New Member
Joined
Jun 28, 2022
Messages
21
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I have been stuck thinking of a way to implement a "Sanitise Sheet" macro for one of my template and was hoping to crowdsource a couple of ideas.

The mission, should you choose to accept, is to have a macro assigned to a button which creates a new .xslx file of a tab, which subsequently copies information from the original tab and pastes values only. This effectively creates a fresh sheet which doesn't carry over any formulas, whilst retaining the look and formatting.

My current code is as follows:

VBA Code:
Sub SanitiseEstimate()

    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim savePath As Variant
    Dim wsCopy As Worksheet
    Dim originalFileName As String
    Dim newFileName As String
    
    ' Set the worksheet you want to copy
    Set ws = ActiveSheet
    
    ' Get the original file name without extension
    originalFileName = ThisWorkbook.Name
    If InStrRev(originalFileName, ".") > 0 Then
        originalFileName = Left(originalFileName, InStrRev(originalFileName, ".") - 1)
    End If
    
    ' Create the new file name
    newFileName = originalFileName & "-ForIssue.xlsx"
    
    ' Prompt user to save the new workbook
    savePath = Application.GetSaveAsFilename(InitialFileName:=newFileName, FileFilter:="Excel Files (*.xlsx), *.xlsx")
    
    ' Check if user canceled the save dialog
    If savePath = False Then Exit Sub
    
    ' Create a new workbook
    Set newWb = Workbooks.Add
    Set wsCopy = newWb.Sheets(1)
    
    ' Copy the values and formats from the original sheet to the new sheet
    With ws
        .Cells.Copy
        wsCopy.Cells.PasteSpecial Paste:=xlPasteValues
        wsCopy.Cells.PasteSpecial Paste:=xlPasteFormats
    End With
    
    ' Copy the print area from the original sheet to the new sheet
    If ws.PageSetup.PrintArea <> "" Then
        wsCopy.PageSetup.PrintArea = ws.PageSetup.PrintArea
    End If
    
    ' Remove extra sheets in the new workbook if any
    Application.DisplayAlerts = False
    Dim sh As Worksheet
    For Each sh In newWb.Worksheets
        If sh.Name <> wsCopy.Name Then sh.Delete
    Next sh
    Application.DisplayAlerts = True
    
    ' Save the new workbook
    newWb.SaveAs Filename:=savePath
    newWb.Close
    
    MsgBox "The sheet has been successfully santised and saved as a standalone workbook.", vbInformation
    
End Sub

Currently, the above macro does this for the active sheet, but I ultimately want to be able to select multiple sheet from the workbook which will then sanitise each sheet respectively and collate them together in one new workbook.xlsx

Do we have any ideas? I toyed with a userform idea which would allow you to select tabs along the bottom row and have a window that adds the tabs so the user can see what will be included before executing. I'm feeling a little creatively bankrupt right now so ideas are welcome, if code is not available.

Kind regards All
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
It's not clear to me if you need to copy the sheet just to replace formulas with values or if you must have sheet copies (with values only) in a new wb. So I'll suggest just replacing the formulas with their resulting values in the current wb.

I wouldn't bother with a form for this. It's seems simple enough to have users select the sheets then trigger the procedure (being an Access guy I hesitate to call them macros). I think all of your concepts have been addressed many times on the 'net and finding code to piece together should not be too difficult.

Once the sheets are selected and the procedure is initiated, it would be like
VBA Code:
Sub loopSelectedSheets()
Dim sht As Worksheet

For Each sht In Application.ActiveWindow.SelectedSheets
    Debug.Print sht.Name
Next

End Sub
With that, my output is
Sheet 3
Sheet4
Sheet5
Sheet6
4
7
Sheet8

Instead of debug.print you'd copy and paste as shown in answer 1 or 2 here Of course, the code I posted could benefit from some validation, such as a message if no sheets are selected, or maybe terminating if one or more particular sheets were selected and should not have been. Things like that.
Hope that helps you get started because lunch is over and I have to get back to my project. 🍕
 
Upvote 0
It's not clear to me if you need to copy the sheet just to replace formulas with values or if you must have sheet copies (with values only) in a new wb. So I'll suggest just replacing the formulas with their resulting values in the current wb.

I wouldn't bother with a form for this. It's seems simple enough to have users select the sheets then trigger the procedure (being an Access guy I hesitate to call them macros). I think all of your concepts have been addressed many times on the 'net and finding code to piece together should not be too difficult.

Once the sheets are selected and the procedure is initiated, it would be like
VBA Code:
Sub loopSelectedSheets()
Dim sht As Worksheet

For Each sht In Application.ActiveWindow.SelectedSheets
    Debug.Print sht.Name
Next

End Sub
With that, my output is
Sheet 3
Sheet4
Sheet5
Sheet6
4
7
Sheet8

Instead of debug.print you'd copy and paste as shown in answer 1 or 2 here Of course, the code I posted could benefit from some validation, such as a message if no sheets are selected, or maybe terminating if one or more particular sheets were selected and should not have been. Things like that.
Hope that helps you get started because lunch is over and I have to get back to my project. 🍕
Thanks mate, I'll have a look through and have a crack at it. I will note that it is clear to me to create a new workbook, and that a copy/paste of values only is required as the original sheet has inter-sheet formulas from sheets that the user may not copy across into the new sanitised workbook. But I like the idea of looping through the selected sheets. It's given me food for thought.

Speaking of food, enjoy your pizza (or other unspecified lunch option)!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,701
Messages
6,173,920
Members
452,539
Latest member
deeme

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top