Save a copy of sheet without macro or formula

[alexg7828]

Hi Guys,

So I've been struggling with this all day and reached the end of my knowledge as I know there must be a much simpler way of doing it ...

Aim
Save the current sheet as a seperate workbook with only values, formatting and images i.e. .xlsm to .xlsx (no macros or formulas) Whilst keeping current workbook open and close the newly saved one immediatley.

I have tried the SaveAsCopy function but you cant select the file type and i have tried to copy and paste as values&formatting to new workbook then save but I can't get the images to copy over at the same time as the cell values.

This is what I currently have, works as I want it to but images do not go over...

Sub TestSaveCopy_Backup()
' TestSaveCopy Macro
Application.CopyObjectsWithCells = True
Columns("A:E").Select
Selection.Copy
Workbooks.Open Filename:= _
Workbooks("TRR_Template.xlsm").Worksheets("Project Info").Range("B4").Value & "\XLSX Template.xlsx"
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=Range("B2").Value & "" & Range("E9").Value & "-TRR-" & Range("E5").Value & "_" & Range("B5") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub

 

[Leith Ross]

Hello alexg7828,

This macro will create a new workbook by copying the Activesheet. No macros or formulas will be copied over and all shapes will be copied as well.

The macro will name the new workbook using cells "B2", "E9", "E5", and "B5" from the active sheet in the new workbook. If you have any problems, let me know.

Sub SaveCopyNoMacros()


    Dim Data    As Variant
    Dim Rng     As Range
    Dim newName As String
    Dim newWkb  As Workbook
    Dim newWks  As Worksheet
    Dim Shp     As Shape
    Dim Wks     As Worksheet
    
        Set Wks = ThisWorkbook.ActiveSheet
        Set Rng = Wks.UsedRange
        
        Data = Rng.Value
        
        Wks.Copy
        Set newWkb = ActiveWorkbook
        Set newWks = newWkb.ActiveSheet
        
        With newWks
            .Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
            newName = .Range("B2").Value & "" & .Range("E9").Value & "-TRR-" & .Range("E5").Value & "_" & .Range("B5") & ".xlsx"
            
            ' Remove any macros attached to the shapes.
            For Each Shp In .Shapes
                Shp.OnAction = ""
            Next Shp
        End With
        
        newWkb.SaveAs newName, xlOpenXMLWorkbook
        newWkb.Close
        
End Sub

 

[alexg7828]

Hi Leith,

Thanks!! Thats perfect, i would have been a long time trying to go the long way round with it, only issue is i get 3 error messages, one when running the macro and another two when opening the produced file... any ideas ....


-- removed inline image ---


-- removed inline image ---


-- removed inline image ---


Thanks in advance!!!

 

[alexg7828]

Hi Leith,

Thanks!! Thats perfect, i would have been a long time trying to go the long way round with it, only issue is i get 3 error messages, one when running the macro and another two when opening the produced file... any ideas ....


-- removed inline image ---


-- removed inline image ---


-- removed inline image ---


Thanks in advance!!!

 

[Leith Ross]

Hello alexg7828,

I can not see the images you posted only the 64 bit encoding for them. Can you try posting them again?

 

[alexg7828]

I'm being really daft here and can't seem to upload images to the reply... how do I upload the URL of a local image ?