Duplicate sheets to new workbook - Only showing values of sheet

[Lee Rabbit]

Hi Guys,

I need a tweak on the code below. It does what I initially wanted but now I only want the contents of the duplicated sheets to show the values.

At present it is showing formula linked back to the original spreadsheet. I want to rid the new workbook of the formulas.

Please see my code below.

Regards and thanks in advance for your help.
Lee

Sub Duplicate_Workbook()

    ActiveWorkbook.Sheets(Array("INVOICE 1", "INVOICE 2", "INVOICE 3")).Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="c:\PDF\test.xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close

End Sub

 

[Fluff]

How about

Sub Duplicate_Workbook()
   Dim ws As Worksheet
   
   ActiveWorkbook.Sheets(Array("INVOICE 1", "INVOICE 2", "INVOICE 3")).Copy
   For Each ws In ActiveWorkbook.Worksheets
      ws.UsedRange.Value = ws.UsedRange.Value
   Next ws
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs Filename:="c:\PDF\test.xlsx", FileFormat:=xlOpenXMLWorkbook
   Application.DisplayAlerts = True
   ActiveWorkbook.Close

End Sub

 

[Lee Rabbit]

How about

Sub Duplicate_Workbook()
   Dim ws As Worksheet
  
   ActiveWorkbook.Sheets(Array("INVOICE 1", "INVOICE 2", "INVOICE 3")).Copy
   For Each ws In ActiveWorkbook.Worksheets
      ws.UsedRange.Value = ws.UsedRange.Value
   Next ws
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs Filename:="c:\PDF\test.xlsx", FileFormat:=xlOpenXMLWorkbook
   Application.DisplayAlerts = True
   ActiveWorkbook.Close

End Sub

Thanks Fluff, worked a treat

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Lee Rabbit]

You're welcome & thanks for the feedback.

Hi Fluff,

I have just noticed that when I copy the sheets to the new workbook, a few cells are reporting the error "number stored as text". These cells were previously formatted as currency and whilst I right click on them and view format, they are still showing as formatted as currency.

Is there a quick fix I can add to the code above to prevent this happening as I would like to see the finished article without the cell error.

Thanks for your patience.
Lee

 

[Fluff]

That shouldn't happen, are you sure they were numbers & not text before hand?

 

[Lee Rabbit]

That shouldn't happen, are you sure they were numbers & not text before hand?

I think I have identified the problem. On the original sheet I was using an ISBLANK formula and rather than setting it to 0.00 the cell reference is putting a £ sign in the cell. I believe this is the conflict as if the preceding cell is blank, it populates as £0.00. I have tested since and it looks like it is copying OK now. Thanks again for your help.

 

[Fluff]

Glad you sorted it & thanks for the feedback.

 

[Lee Rabbit]

Glad you sorted it & thanks for the feedback.

 

[Lee Rabbit]

Hi Fluff, sorry to bother you.

I made some amendments to the code see below of which I am happy with, however, I am trying to include a couple of sheets from external workbooks that are located in the same folder as the original. Workbooks are named "EXPORT 1" sheet name "TEST 1" and "EXPORT 2" sheet name "TEST 2".

Is there a way to merge this action into the existing code?

Thanks in advance.
Lee

Sub Duplicate_Workbook()

Dim ws As Worksheet
Dim strFileName As String

    strFileName = InputBox("Type a name for the new workbook", "File Name")
    If Trim(strFileName) = vbNullString Then Exit Sub
    
    ActiveWorkbook.Sheets(Array("INVOICE 1", "INVOICE 2", "INVOICE 3", "INVOICE 4", "INVOICE 5", "INVOICE 6", "INVOICE 7")).Copy
    
    For Each ws In ActiveWorkbook.Worksheets
    
        ws.UsedRange.Value = ws.UsedRange.Value
        ws.Rows(3).Delete
        ws.Shapes("CopyRow").Delete
        ws.Shapes("SortDrivers").Delete
        ws.Shapes("DeleteENTRY").Delete
        
    Next ws
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\PDF\" & strFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
    
End Sub