Public Sub Save_Last_3_Sheets()
Dim newWb As Workbook
Dim newXlsxFullName As String
Dim p As Long, i As Long
Dim sheetName As String
Dim currentWb As Workbook
Set newWb = Workbooks.Add(xlWBATWorksheet)
newWb.Worksheets(1).Name = "_"
With ThisWorkbook
p = InStrRev(.FullName, ".")
newXlsxFullName = Left(.FullName, p - 1) & "values.xlsx"
For i = .Worksheets.Count - 2 To .Worksheets.Count
sheetName = .Worksheets(i).Name
.Worksheets(i).Cells.Copy
newWb.Worksheets.Add After:=newWb.Worksheets(newWb.Worksheets.Count)
With newWb.Worksheets(newWb.Worksheets.Count)
.Paste
.UsedRange.Value = .UsedRange.Value
.Range("A1").Select
.Name = sheetName
End With
Next
End With
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 newXlsxFullName, FileFormat:=xlOpenXMLWorkbook
newWb.Close SaveChanges:=False
If Err.Number = 0 Then
MsgBox "Saved " & newXlsxFullName, vbInformation
Else
MsgBox "Error saving " & newXlsxFullName & vbCrLf & vbCrLf & "Error number " & Err.Number & vbCrLf & Err.Description, vbExclamation
End If
On Error GoTo 0
Application.DisplayAlerts = True
End Sub