Save Worksheets As Seperate Workbooks Based On Conditions

Hi Everyone,

Please help me again in my project. I have to save a specific worksheet when a value is seen in a specific range.

Here's my code.

Code:

---



Sub export()

Dim keyword As String
Sheets("INSTRUCTIONS").Activate
keyword = Range("O24").Value

If keyword = "AMERICAS" Then

    Sheets("CLASSIFIED-americas").Copy
    With ActiveWorkbook
    '.Title = "Classified"
    .SaveAs Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls"), xls
        '.Close True

    If keyword = "RRRS" Then
        Sheets("CLASSIFIED-RRRS").Copy
          With ActiveWorkbook
          '  .Title = "Classified"
          .SaveAs Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls"), xls
            ' .Close True

        If keyword = "RRR" Then
            Sheets("CLASSIFIED-RRR").Copy
            With ActiveWorkbook
            '  .Title = "Classified"
            .SaveAs Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls"), xls
              ' .Close True

End If
    End If
        End If
            End If
       

   
    Application.DisplayAlerts = True
 
 
End With
End Sub

---

Thank you for those who will help me. :)

attach please a sample file for testing

Hi

Untested.

Code:

---

Option Explicit

Sub Export()

    Dim Keyword As String
   
    Keyword = UCase$(Worksheets("INSTRUCTIONS").Range("O24").Value)
   
    Application.DisplayAlerts = False
   
    Select Case Keyword
        Case "AMERICAS"
            Sheets("CLASSIFIED-americas").Copy
            With ActiveWorkbook
                '.Title = "Classified"
                .SaveAs Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls", "xls")
                '.Close True
            End With
       
        Case "RRRS"
            Sheets("CLASSIFIED-RRRS").Copy
            With ActiveWorkbook
                '  .Title = "Classified"
                .SaveAs Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls", "xls")
                ' .Close True
            End With
       
        Case "RRR"
            Sheets("CLASSIFIED-RRR").Copy
            With ActiveWorkbook
                '  .Title = "Classified"
                .SaveAs Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls", "xls")
              ' .Close True
            End With
    End Select
    Application.DisplayAlerts = True

End Sub

---

It seems that the

Code:

---

.SaveAs Application.GetSaveAsFilename("FILENAME HERE", "Excel 97-2003 Workbook (*.xls), *.xls", "xls")

---

is having an error while compiling. Please help. It has an error of Method SaveAs of the Workbook as Failed or the Runtime Error 1004

Thanks!

Hi

Try this

Code:

---

Option Explicit

Sub Export()

    Dim Keyword As String
    Dim FName  As Variant
   
    Keyword = UCase$(Worksheets("INSTRUCTIONS").Range("O24").Value)
   
    Select Case Keyword
        Case "AMERICAS"
            Sheets("CLASSIFIED-americas").Copy
            FName = Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls")
        Case "RRRS"
            Sheets("CLASSIFIED-RRRS").Copy
            FName = Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls")
        Case "RRR"
            Sheets("CLASSIFIED-RRR").Copy
            FName = Application.GetSaveAsFilename("CLASSIFIED", "Excel 97-2003 Workbook (*.xls), *.xls")
    End Select
   
    If Not IsEmpty(FName) Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs FName
        Application.DisplayAlerts = True
    End If
   
End Sub

---