VBA - save 2 worksheets without formulas in excel and pdf

louisepr

New Member
Joined
Nov 5, 2020
Messages
27
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Hi :)
I am looking for assistance in VBA code to save 2 worksheets (out of 7) to a new excel file with a defined name and without the formulas. I am also then needing a pdf version of only the second worksheet (which will be the active worksheet when running the macro). If anyone can help me, that would be amazing. Thanks in advance :)
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,905
Try this macro, changing the output xlsx and pdf file names and the sheet names listed in Array("Sheet1", "Sheet2") as required.

VBA Code:
Public Sub Save_2_Sheets()

    Dim xlsxFullName As String, PDFFullName As String
    Dim newWb As Workbook
    Dim sheetName As Variant
    
    xlsxFullName = ThisWorkbook.Path & "\New workbook.xlsx"
    PDFFullName = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".pdf"
    
    'Save active sheet as PDF
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFullName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Set newWb = Workbooks.Add(xlWBATWorksheet)
    newWb.Worksheets(1).Name = "_"
    For Each sheetName In Array("Sheet1", "Sheet2")
        ThisWorkbook.Worksheets(sheetName).Cells.Copy
        newWb.Worksheets.Add after:=newWb.Worksheets(newWb.Worksheets.Count)
        With newWb.Worksheets(newWb.Worksheets.Count)
            .Paste
            .UsedRange.Value = .UsedRange.Value
            .Name = sheetName
        End With
    Next
    Application.CutCopyMode = False
    
    'Suppress warning for sheet deletion and for saving in case new workbook already exists
    
    Application.DisplayAlerts = False
    
    newWb.Worksheets(1).Delete
    
    On Error Resume Next
    newWb.SaveAs xlsxFullName, FileFormat:=xlOpenXMLWorkbook
    newWb.Close SaveChanges:=False
    If Err.Number = 0 Then
        MsgBox ActiveSheet.Name & " saved as " & PDFFullName & vbCrLf & vbCrLf & _
               "Values of 2 Sheets saved as " & xlsxFullName, vbInformation
    Else
        MsgBox ActiveSheet.Name & " saved as " & PDFFullName & vbCrLf & vbCrLf & _
               "But values of 2 Sheets not saved as xlsx", vbExclamation
    End If
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    
End Sub
 
Solution

Forum statistics

Threads
1,137,115
Messages
5,679,712
Members
419,852
Latest member
ddewaard17

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
Top