Copy all sheets to new workbook without formulas and macros

[Remco678]

Hi All,

I want to copy my whole workbook (xlsm) with formulas and macros to a whole new excel file (xlsx) without any formula and macro. I've found the script below on internet and works fine but is for 1 certain sheet. How can i include multiple sheets and copy this to the new workbook? It is important that the original file keeps the formulas and macros.

Thanks in advance

Sub Tweedeopslaan()
    Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet
    
    Dim SavePath As String, i As Integer
    
    Set SourceBook = ThisWorkbook
    
    '*********************************************
    'Edit next two lines as necessary
    SavePath = "C:\Users\User\Desktop\New folder\TestSaveValues.xlsx"
    Set SourceSheet = SourceBook.Sheets("Juni")
    '*********************************************
    
    Set DestBook = Workbooks.Add
    Set DestSheet = DestBook.Worksheets.Add
    
    Application.DisplayAlerts = False
    For i = DestBook.Worksheets.Count To 2 Step -1
        DestBook.Worksheets(i).Delete
    Next i
    Application.DisplayAlerts = True
    
    SourceSheet.Cells.Copy
    With DestSheet.Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
    End With
    
    DestSheet.Name = SourceSheet.Name
    
    Application.DisplayAlerts = False 'Delete if you want overwrite warning
    DestBook.SaveAs Filename:=SavePath
    Application.DisplayAlerts = True 'Delete if you delete other line
    
    SavePath = DestBook.FullName
    DestBook.Close 'Delete if you want to leave copy open
    MsgBox ("A copy has been saved to " & SavePath)
End Sub

 

[dave3009]

Personally I would just cycle through the current workbook and set each sheet to values, then saveas an xlsx which would remove the VBA.

Option Explicit

Sub SaveFlatCopy()
Dim SavePath As String
Dim sh As Worksheet
Dim reopenWB as String
Dim calcMode As XlCalculation

SavePath = ThisWorkbook.Path & "\"
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 & "FlatVersion" & Format(Now, "yyyymmddhhmmss"), 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

 

[Remco678]

Legend! Thank you very much. It works like a charm

 

[dave3009]

Thanks for the feedback. Could you mark the post as solved. Thank you