• 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Need to Split data.
#1
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.  Smile


Attached Files
.xlsx   Question.xlsx (Size: 8.91 KB / Downloads: 5)
  Reply
#2
(25-Jul-2017, 04:18 PM)Gourav Kumar Wrote: 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.  Smile

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


Attached Files
.zip   Split_data.zip (Size: 16.44 KB / Downloads: 3)
  Reply
#3
(25-Jul-2017, 08:27 PM)Lovedeep sharma Wrote:
(25-Jul-2017, 04:18 PM)Gourav Kumar Wrote: 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.  Smile

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


Attached Files
.xlsx   Question.xlsx (Size: 9.26 KB / Downloads: 2)
  Reply
#4
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
  Reply
#5
(26-Jul-2017, 01:57 PM)Lovedeep sharma Wrote:
(26-Jul-2017, 01:36 PM)Gourav Kumar Wrote:
(25-Jul-2017, 08:27 PM)Lovedeep sharma Wrote:
(25-Jul-2017, 04:18 PM)Gourav Kumar Wrote: 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.  Smile

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.
  Reply
#6
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
  Reply
#7
(26-Jul-2017, 07:30 PM)Lovedeep sharma Wrote: 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.... Smile
  Reply


Related Topics
Topic Author Replies Views Last Post
  Data Splitting Want to split data in Tabs Anil Kumar Pal 2 2,701 22-May-2017, 11:42 AM
Last Post: Anil Kumar Pal

Forum Jump:


Users browsing this topic: 1 Guest(s)