Data Splitting Need to Split data.

[Gourav Kumar]

Hi All,

Please find attached query sheet and help me to resolve this. I need to create separate workbook according to PLAN and each workbook having worksheet with Issue(Refer attached sheet) with VBA Code.
For example if i run the code it gives me file with name 171SFA that contain 5 sheets with name-A,D,E,G,K with their respective data.
I am only able to create separate worksheets in a workbook, can't able to split in different workbooks.   

Many thanks in advance.  

[Lovedeep sharma]

Hi All,

Please find attached query sheet and help me to resolve this. I need to create separate workbook according to PLAN and each workbook having worksheet with Issue(Refer attached sheet) with VBA Code.
For example if i run the code it gives me file with name 171SFA that contain 5 sheets with name-A,D,E,G,K with their respective data.
I am only able to create separate worksheets in a workbook, can't able to split in different workbooks.   

Many thanks in advance.  

Hi,

please find below Code & Zip file also attached 

Sub Split_data()

Dim data As Worksheet
Dim temp As Worksheet ' ''''(xlsheetveryhiden)
Dim i As Integer
Dim sh_name As Variant
Dim path As String

        path = ThisWorkbook.path
        Set data = Worksheets("DATA")
        Set temp = Worksheets("temp")


                temp.Range("A:A").Clear
                data.Range("A:A").Copy temp.Cells(1, 1)
                temp.Range("A:A").RemoveDuplicates 1

For i = 2 To WorksheetFunction.CountA(temp.Range("A:A"))

sh_name = temp.Cells(i, 1)
        Workbooks.Add
        ActiveSheet.Name = sh_name
        
        data.Range("A1:H1").AutoFilter 1, sh_name
        data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1")
        Columns.AutoFit
        
        ActiveWorkbook.SaveAs Filename:=path & "\" & "Plan worksheets" & "\" & sh_name & ".xlsx"
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        data.Range("A1").AutoFilter
        
Next
 
End Sub

[Gourav Kumar]

Hi All,

Please find attached query sheet and help me to resolve this. I need to create separate workbook according to PLAN and each workbook having worksheet with Issue(Refer attached sheet) with VBA Code.
For example if i run the code it gives me file with name 171SFA that contain 5 sheets with name-A,D,E,G,K with their respective data.
I am only able to create separate worksheets in a workbook, can't able to split in different workbooks.   

Many thanks in advance.  

Hi,

please find below Code & Zip file also attached 

Sub Split_data()

Dim data As Worksheet
Dim temp As Worksheet ' ''''(xlsheetveryhiden)
Dim i As Integer
Dim sh_name As Variant
Dim path As String

        path = ThisWorkbook.path
        Set data = Worksheets("DATA")
        Set temp = Worksheets("temp")


                temp.Range("A:A").Clear
                data.Range("A:A").Copy temp.Cells(1, 1)
                temp.Range("A:A").RemoveDuplicates 1

For i = 2 To WorksheetFunction.CountA(temp.Range("A:A"))

sh_name = temp.Cells(i, 1)
        Workbooks.Add
        ActiveSheet.Name = sh_name
        
        data.Range("A1:H1").AutoFilter 1, sh_name
        data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1")
        Columns.AutoFit
        
        ActiveWorkbook.SaveAs Filename:=path & "\" & "Plan worksheets" & "\" & sh_name & ".xlsx"
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        data.Range("A1").AutoFilter
        
Next
 
End Sub

Hi Lovedeep,

Thanks for the coding, however i need to clear one doubt .
Could you please suggest why we are using 23 in data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1") code.
I am attaching actual data where i need to run this code.

Thanks

[Lovedeep sharma]

data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1")

this line of code will copy only filter record  and paste new workbook active sheet 

if you want run this code given sample data file then you need modify code

old code -data.Range("A1:H1").AutoFilter 1, sh_name
 
new code -data.Range("A1:w1").AutoFilter 1, sh_name

[Gourav Kumar]

Hi All,

Please find attached query sheet and help me to resolve this. I need to create separate workbook according to PLAN and each workbook having worksheet with Issue(Refer attached sheet) with VBA Code.
For example if i run the code it gives me file with name 171SFA that contain 5 sheets with name-A,D,E,G,K with their respective data.
I am only able to create separate worksheets in a workbook, can't able to split in different workbooks.   

Many thanks in advance.  

Hi,

please find below Code & Zip file also attached 

Sub Split_data()

Dim data As Worksheet
Dim temp As Worksheet ' ''''(xlsheetveryhiden)
Dim i As Integer
Dim sh_name As Variant
Dim path As String

        path = ThisWorkbook.path
        Set data = Worksheets("DATA")
        Set temp = Worksheets("temp")


                temp.Range("A:A").Clear
                data.Range("A:A").Copy temp.Cells(1, 1)
                temp.Range("A:A").RemoveDuplicates 1

For i = 2 To WorksheetFunction.CountA(temp.Range("A:A"))

sh_name = temp.Cells(i, 1)
        Workbooks.Add
        ActiveSheet.Name = sh_name
        
        data.Range("A1:H1").AutoFilter 1, sh_name
        data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1")
        Columns.AutoFit
        
        ActiveWorkbook.SaveAs Filename:=path & "\" & "Plan worksheets" & "\" & sh_name & ".xlsx"
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        data.Range("A1").AutoFilter
        
Next
 
End Sub

Hi Lovedeep,

Thanks for the coding, however i need to clear one doubt .
Could you please suggest why we are using 23 in data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1") code.
I am attaching actual data where i need to run this code.

Thanks

data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1")

this line of code will copy only filter record  and paste new workbook active sheet 

if you want run this code given sample data file then you need modify code

old code -data.Range("A1:H1").AutoFilter 1, sh_name
 
new code -data.Range("A1:w1").AutoFilter 1, sh_name

Hi,

I have already modified the range, but code is showing error message in data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1") code.
You can also find this error when you run the same code in previous file i have attached.
Please help me out.

[Lovedeep sharma]

You please use sheet which is shared by me only... as there is a hidden temp sheet in my file so do required modification in this file

agar aapko "data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1") code." es line se hi problem hai esi mai error aa rha hai to es  code ko delete karke es code  replace kar sakte hai

    data.Activate
        data.Range("A1:B1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows(2).Activate
        ActiveSheet.Range("a1").Select
        ActiveSheet.Paste

dono code same action preform karege

[Gourav Kumar]

You please use sheet which is shared by me only... as there is a hidden temp sheet in my file so do required modification in this file

agar aapko "data.Cells.SpecialCells(xlCellTypeConstants, 23).Copy ActiveSheet.Range("a1") code." es line se hi problem hai esi mai error aa rha hai to es  code ko delete karke es code  replace kar sakte hai

    data.Activate
        data.Range("A1:B1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows(2).Activate
        ActiveSheet.Range("a1").Select
        ActiveSheet.Paste

dono code same action preform karege

Hi Lovedeep,

Thanks. Now its working....