How to save all the Excel file in same folder with 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

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

 

[ramya0313]

Ok, so I understand now that you use the dictionary to get UNIQUE values from Column A. Disregard my comments about duplicate values in Column A.

But I am still confused. Can you tell me what this code is supposed to do?

        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

I am trying to understand how column F is involved. It seems that you are trying to determine if the value in Column F = the value in Column A. But there are no matches like that.

the below mentioned code is working fine it is splitting the entire Excel sheet based on first five digits on colum value

Guide me to set the location to save the files
Thank you

 

[OaklandJim]

Unfortunately, I suspect that we have a bit of a language problem. I hope that is not a problem.

I will be out of town until Thursday.

I'll try again to understand what you need. But, sorry I am confused. I'm not able to understand what data is stored in what files. Please try to answer these questions:

What do you mean by "split the Excel file"?

Will there be five new workbooks or two?

Based on the example, what should the file names be?

What data should the new workbook files contain?

Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the Mr Excel message area. Make sure that other people can access the file(s)!

 

[ramya0313]

Unfortunately, I suspect that we have a bit of a language problem. I hope that is not a problem.

I will be out of town until Thursday.

I'll try again to understand what you need. But, sorry I am confused. I'm not able to understand what data is stored in what files. Please try to answer these questions:

What do you mean by "split the Excel file"?

Will there be five new workbooks or two?

Based on the example, what should the file names be?

What data should the new workbook files contain?

Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the Mr Excel message area. Make sure that other people can access the file(s)!

names.xlsx

 

[ramya0313]

names.xlsx

I uploaded the file in Google drive and shared the link
Here I have a excel with large data I want to split the data into small files based on the column value.i need to split based on first 5 digits in F column
Like 1396A,0001,0003A in separate files
The excel I shared with u uses VBA code and splits the file into 10 separate files I attached the photo here
Like book1,book2 etc

 

[ramya0313]

The pro

Unfortunately, I suspect that we have a bit of a language problem. I hope that is not a problem.

I will be out of town until Thursday.

I'll try again to understand what you need. But, sorry I am confused. I'm not able to understand what data is stored in what files. Please try to answer these questions:

What do you mean by "split the Excel file"?

Will there be five new workbooks or two?

Based on the example, what should the file names be?

What data should the new workbook files contain?

Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the Mr Excel message area. Make sure that other people can access the file(s)!

The Problem is I want to save the file in same folder where the name excel (which I shared) is located automatically.
And in the format 01_03_1396A_yyyymmd
01_03_0001A_yyymmdd
01_03_0003A_yyymmdd
I have to save all the 10 excel in same folder with the first 5 value in f column

 

[ramya0313]

names.xlsx

Unfortunately, I suspect that we have a bit of a language problem. I hope that is not a problem.

I will be out of town until Thursday.

I'll try again to understand what you need. But, sorry I am confused. I'm not able to understand what data is stored in what files. Please try to answer these questions:

What do you mean by "split the Excel file"?

Will there be five new workbooks or two?

Based on the example, what should the file names be?

What data should the new workbook files contain?

Put the file on Dropbox, Box, 1Drive, Google Drive etc. Use the link icon above the Mr Excel message area. Make sure that other people can access the file(s)!

VBA CODE

Sub SplitSheetIntoMultipleWorkbooksBasedOnColumn()
Dim objWorksheet As Excel.Worksheet
Dim nLastRow As Integer, nRow As Integer, nNextRow As Integer
Dim strColumnValue As String
Dim objDictionary As Object
Dim varColumnValues As Variant
Dim varColumnValue As Variant
Dim objExcelWorkbook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Set objWorksheet = ActiveSheet
nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row
Set objDictionary = CreateObject("Scripting.Dictionary")
For nRow = 2 To nLastRow
strColumnValue = Left(objWorksheet.Range("F" & nRow).Value, 5)
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 objExcelWorkbook = Excel.Application.Workbooks.Add
Set objSheet = objExcelWorkbook.Sheets(1)
objSheet.Name = objWorksheet.Name
objWorksheet.Rows(1).EntireRow.Copy
objSheet.Activate
objSheet.Range("A1").Select
objSheet.Paste
For nRow = 2 To nLastRow
If Left(CStr(objWorksheet.Range("F" & nRow).Value), 5) = CStr(varColumnValue) Then
objWorksheet.Rows(nRow).EntireRow.Copy
nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1
objSheet.Range("A" & nNextRow).Select
objSheet.Paste
objSheet.Columns("A:H").AutoFit
End If

Next
Next
End Sub