How to save multiple output excel in single folder in the given format

[Ramya0313]

Hi i want to save all the excel output files in same folder ,i have a vba code but the files are not saving in the folder. The file should be saved in the format with first 5 digits in F column that is (example 1396A)

Format
01_03_1396A_yyyymmdd

Excel sample file
https://i.stack.imgur.com/CN6sO.png

Vba code

Sub SplitSheetIntoMultipleSheetsBasedOnColumn()
    Dim objWorksheet As Excel.Worksheet
    Dim nLastRow, nRow, nNextRow As Integer
    Dim strColumnValue As String
    Dim objDictionary As Object
    Dim varColumnValues As Variant
    Dim varColumnValue As Variant
    Dim objSheet As Excel.Worksheet
    Dim FPath As String
    
    Set objWorksheet = ActiveSheet
    nLastRow = objWorksheet.Range("F" & objWorksheet.Rows.Count).End(xlUp).Row
    Set objDictionary = CreateObject("Scripting.Dictionary")
    
    For nRow = 2 To nLastRow
        strColumnValue = objWorksheet.Range("A" & nRow).Value
        If objDictionary.Exists(strColumnValue) = False Then
           objDictionary.Add strColumnValue, 1
        End If
    Next
    
    varColumnValues = objDictionary.Keys
    
    For i = LBound(varColumnValues) To UBound(varColumnValues)
        varColumnValue = varColumnValues(i)
        Set objSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        objSheet.Name = varColumnValue
        objWorksheet.Rows(1).EntireRow.Copy objSheet.Rows(1)
        For nRow = 2 To nLastRow
            If CStr(objWorksheet.Range("F" & nRow).Value) = CStr(varColumnValue) Then
                objWorksheet.Rows(nRow).EntireRow.Copy
                nNextRow = objSheet.Range("A" & objSheet.Rows.Count).End(xlUp).Row + 1
                objSheet.Range("A" & nNextRow).PasteSpecial xlPasteValuesAndNumberFormats
            End If
            FPath = Application.ActiveWorkbook.Path
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            For Each ws In ThisWorkbook.Sheets
                 ws.Copy
                 Application.ActiveWorkbook.SaveAs Filename:=FPath & "" & ws.Name & ".xlsx"
                 Application.ActiveWorkbook.Close False
            Next
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
        Next
        objSheet.Columns("A:H").AutoFit
    Next
End Sub

[June7]

Please post code between CODE tags to retain indentation and readability. Use # icon on the post edit toolbar. Edit your original post.

[anish.ms]

Few issues that I observed in your code-
variables 'i' and 'ws' are not declared.
you are adding the values in column A to dictionary and then comparing that with the values in column F
unable to understand what you are trying to do here.