Create new file from original and change file name based on cell value 1

[vlbridge]

I have the following code:

Sub test()
    Dim ws As Worksheet, wsSummary As Worksheet, lRow As Long, bCOPY As Boolean
    
    Set wsSummary = Sheets("Final")
    
 Application.ScreenUpdating = False
    
    For Each ws In Worksheets
        With ws
            Select Case .Name
                Case wsSummary.Name
                    bCOPY = False
                Case Else
                    bCOPY = True
                    If lRow = 0 Then
                        lRow = 1
                    Else
                        lRow = wsSummary.UsedRange.Rows.Count + 1
                    End If
            End Select
            
            If bCOPY Then
                .UsedRange.Copy
                wsSummary.Cells(lRow, "A").PasteSpecial xlPasteAll
            End If
        End With
    Next
    
    Set wsSummary = Nothing
    
    With Sheets("Final")
        .Columns("D:D").AutoFilter
        .Columns("D:D").AutoFilter Field:=1, Criteria1:="<>UnSat"
        .Rows("2:" & .Rows.Count).Delete Shift:=xlUp
        .Columns("D:D").AutoFilter Field:=1
    End With
    
Sheets("Final").Select

    Range("A1").Select
    Selection.ClearContents
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Crew Knowledge").Select
    Range("A1:G2").Select
    Selection.Copy
    Sheets("Final").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1:G1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Final Audit"
    Range("A1:G1").Select
    Selection.AutoFilter
    
    Sheets("SUMMARY").Select
    Sheets("SUMMARY").Copy
    ChDir "H:\"
    ActiveWorkbook.SaveAs Filename:="H:\FinalAudit.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Windows("New 2012 Annual Vessel Audit Form.xlsm").Activate
    Sheets("Final").Select
    Sheets("Final").Copy After:=Workbooks("FinalAudit.xlsx").Sheets(1)
    Sheets("SUMMARY").Select
    Application.Dialogs(xlDialogSendMail).Show

Application.ScreenUpdating = True



End Sub

This summarizes the information from the different audit sheet, creates a new file with the summary sheets, saves it, and attaches it to an e-mail. Here's the problem. Currently, it's just saving it as "FinalAudit.xlsx". I would like it to save it as "M/V_______________FinalAudit.xlsx". The blank would be the name of the vessel filling out the form. This is found in cell C1 on the "SUMMARY" tab. Any help would be appreciated. Thank you.

 

[SkipVought]

hi,

I would like it to save it as "M/V_______________FinalAudit.xlsx". The blank would be the name of the vessel filling out the form. This is found in cell C1 on the "SUMMARY" tab. Any help would be appreciated.

with Sheets("SUMMARY")
  thisworkbook.saveas Filename:="H:\M/V" & .[C1] & "FinalAudit.xlsx" , FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

end with

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

ok... I tried that. Here is how I put it into the code:

Sub test()
    Dim ws As Worksheet, wsSummary As Worksheet, lRow As Long, bCOPY As Boolean
    
    Set wsSummary = Sheets("Final")
    
 Application.ScreenUpdating = False
    
    For Each ws In Worksheets
        With ws
            Select Case .Name
                Case wsSummary.Name
                    bCOPY = False
                Case Else
                    bCOPY = True
                    If lRow = 0 Then
                        lRow = 1
                    Else
                        lRow = wsSummary.UsedRange.Rows.Count + 1
                    End If
            End Select
            
            If bCOPY Then
                .UsedRange.Copy
                wsSummary.Cells(lRow, "A").PasteSpecial xlPasteAll
            End If
        End With
    Next
    
    Set wsSummary = Nothing
    
    With Sheets("Final")
        .Columns("D:D").AutoFilter
        .Columns("D:D").AutoFilter Field:=1, Criteria1:="<>UnSat"
        .Rows("2:" & .Rows.Count).Delete Shift:=xlUp
        .Columns("D:D").AutoFilter Field:=1
    End With
    
Sheets("Final").Select

    Range("A1").Select
    Selection.ClearContents
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Crew Knowledge").Select
    Range("A1:G2").Select
    Selection.Copy
    Sheets("Final").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1:G1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Final Audit"
    Range("A1:G1").Select
    Selection.AutoFilter
    
    Sheets(Array("SUMMARY", "Final")).Select
    Sheets("Final").Activate
    Sheets(Array("SUMMARY", "Final")).Copy
    
  
    ChDir "H:\"
    
    With Sheets("SUMMARY")
        ThisWorkbook.SaveAs Filename:="H:\M/V" & .[C1] & "Audit Corrective Action Form.xlsx", FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False

    End With
    
    Sheets("SUMMARY").Select
    Application.Dialogs(xlDialogSendMail).Show

Application.ScreenUpdating = True



End Sub

It gives me an error about saving features in macro-free workbooks. Did I do something wrong? How can I fix that?

 

[SkipVought]

To save a workbook with macros, as you no doubt have experienced, you must save in an Excel Macro-Enabled Workbook, having the file extension, [highlight].xlsm[/highlight].

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

I changed the extention and still get the error.

 

[vlbridge]

Ok I got it... stupid me had a slash in the name of the file, which isn't valid. So, that is what was causing the problem. It works well. Thank you again.

 

[SkipVought]

FileFormat:=xlOpenXMLWorkbookMacroEnabled


Skip,

_{Just traded in my old subtlety...
for a NUANCE!}