Save Worksheets As Seperate Workbooks Based On Conditions

[jffryjsphbyn]

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.





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]

attach please a sample file for testing

[Admin]

Hi

Untested.


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]

It seems that the


.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]

Hi

Try this


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