vba code to save selected sheets as new file

[isuckatvba]

I have a file, lets call it 'filexyz', with multiple tabs. the last three tabs ('1','2','3') are formula based the reference other tabs within the workbook. is there a way to write a macro/vba to create a new file called 'filexyzvalues' in the same folder location as the initial file location that only has tabs 1,2, and 3? it needs to be pasted as values and pasted with the same format into the new file. thanks!!

 

[John_w]

Try this macro.

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