How to save all the Excel file in same folder with the given format

ramya0313

New Member
Joined
Aug 8, 2023
Messages
12
Office Version
  1. 2016
Hi i want to save all the excel output files in same
1000033463.png
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
 
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?

VBA Code:
        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
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
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)!
 
Last edited:
Upvote 0
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
 
Upvote 0
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


1000034268.jpg
 
Upvote 0
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
 
Upvote 0

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
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top