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