Save Worksheets As Seperate Workbooks Based On Conditions

**jffryjsphbyn** · 07-16-2013, 04:38 PM

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.

**patel** · 07-16-2013, 06:14 PM

attach please a sample file for testing

**Admin** · 07-16-2013, 09:57 PM

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

**jffryjsphbyn** · 07-17-2013, 05:49 AM

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!

**Admin** · 07-17-2013, 07:15 AM

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