Split Data into separate worksheet based on Cell values

[earthworm]

I have a below sample data set

Testing.xlsb
	A	B	C	D	E
1	S.no	A	B	C	D
2	A1	783	873	724	745
3	A1	867	796	903	796
4	A1	993	780	713	737
5	A1	701	859	909	850
6	A1	829	918	745	750
7	A1	812	850	874	906
8	A1	880	783	769	919
9	A1	734	837	876	944
10	A1	888	732	864	749
11	A1	942	773	711	864
12	A1	920	758	771	825
13	A2	964	754	912	964
14	A2	839	727	872	895
15	A2	926	834	730	811
16	A2	792	793	767	938
17	A2	892	857	950	902
18	A2	982	979	866	973
19	A3	765	880	789	777
20	A3	918	883	789	956
21	A3	795	739	735	747
22	A3	724	807	747	718
23	A3	976	943	864	752
24	A3	983	769	848	992
25	A3	855	717	954	890
26	A3	989	917	873	849
27	A3	862	792	956	954
28	A4	908	865	848	780
29	A4	911	740	952	701
30	A4	851	999	786	736
31	A4	868	987	794	857
32	A4	805	888	725	835
33	A4	788	763	951	798
34	A4	901	912	855	932
35	A4	757	736	761	937
36	A4	708	989	965	903
37	A4	782	769	802	877
38	A4	864	990	829	721
39	A4	790	918	971	843
40	A4	866	892	817	711
41	A4	790	786	718	818
42	A4	928	978	798	786
43	A5	980	746	751	832
44	A5	962	928	847	982
45	A5	890	838	704	825
46	A5	821	924	792	877
47	A5	989	730	798	956
48	A5	913	957	991	777
49	A5	899	880	812	901
50	A5	988	999	863	881
51	A5	842	765	767	799
52	A5	908	747	999	933
53	A5	914	967	897	781
54	A5	733	726	918	771
55	A5	969	870	929	943
56	A5	853	831	905	987
57	A5	895	794	707	715
58	A5	975	803	935	790
59	A5	813	836	764	708
60	A5	847	946	788	990
61	A5	990	823	723	753
62	A5	711	874	708	960
63	A5	755	747	905	830
64	A5	878	831	849	832
65	A5	733	957	994	704
66	A5	869	894	966	804
67	A5	989	853	951	848
68	A5	982	839	973	750
69	A5	714	763	968	868
70	A5	967	823	834	860
Sheet1

I need to split data based on below table in seperate worksheet and save on PC Desktop

Testing.xlsb
	G	H	I	J
1	Total Count	Data Count	SplitSize	Number of Files
2	A1	11	5	3
3	A2	6	5	2
4	A3	9	5	2
5	A4	15	5	3
6	A5	28	5	6
Sheet1

Cell Formulas
Range	Formula
H2:H6	H2	=COUNTIF(A:A,G2)
J2:J6	J2	=CEILING(H2/I2,1)

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet1!$A$1:$E$70	H2:H6

Example Apply Filter on Column A1 and select value based on Range G1 and then select the first 5 rows of the filtered data , copy and paste the data in new worksheet along with header and save it on desktop. then again select data of filtered data in Column A1 and select the from 6th rosw of remaining data till 5 data and save second sheet and lastly select last value of A1 and save it in seperate worksheet . There will be 3 files containing all A1 data. and move to next value I.E A2 and so on.

 

[Herakles]

I have a below sample data set

Testing.xlsb
	A	B	C	D	E
1	S.no	A	B	C	D
2	A1	783	873	724	745
3	A1	867	796	903	796
4	A1	993	780	713	737
5	A1	701	859	909	850
6	A1	829	918	745	750
7	A1	812	850	874	906
8	A1	880	783	769	919
9	A1	734	837	876	944
10	A1	888	732	864	749
11	A1	942	773	711	864
12	A1	920	758	771	825
13	A2	964	754	912	964
14	A2	839	727	872	895
15	A2	926	834	730	811
16	A2	792	793	767	938
17	A2	892	857	950	902
18	A2	982	979	866	973
19	A3	765	880	789	777
20	A3	918	883	789	956
21	A3	795	739	735	747
22	A3	724	807	747	718
23	A3	976	943	864	752
24	A3	983	769	848	992
25	A3	855	717	954	890
26	A3	989	917	873	849
27	A3	862	792	956	954
28	A4	908	865	848	780
29	A4	911	740	952	701
30	A4	851	999	786	736
31	A4	868	987	794	857
32	A4	805	888	725	835
33	A4	788	763	951	798
34	A4	901	912	855	932
35	A4	757	736	761	937
36	A4	708	989	965	903
37	A4	782	769	802	877
38	A4	864	990	829	721
39	A4	790	918	971	843
40	A4	866	892	817	711
41	A4	790	786	718	818
42	A4	928	978	798	786
43	A5	980	746	751	832
44	A5	962	928	847	982
45	A5	890	838	704	825
46	A5	821	924	792	877
47	A5	989	730	798	956
48	A5	913	957	991	777
49	A5	899	880	812	901
50	A5	988	999	863	881
51	A5	842	765	767	799
52	A5	908	747	999	933
53	A5	914	967	897	781
54	A5	733	726	918	771
55	A5	969	870	929	943
56	A5	853	831	905	987
57	A5	895	794	707	715
58	A5	975	803	935	790
59	A5	813	836	764	708
60	A5	847	946	788	990
61	A5	990	823	723	753
62	A5	711	874	708	960
63	A5	755	747	905	830
64	A5	878	831	849	832
65	A5	733	957	994	704
66	A5	869	894	966	804
67	A5	989	853	951	848
68	A5	982	839	973	750
69	A5	714	763	968	868
70	A5	967	823	834	860
Sheet1

I need to split data based on below table in seperate worksheet and save on PC Desktop

Testing.xlsb
	G	H	I	J
1	Total Count	Data Count	SplitSize	Number of Files
2	A1	11	5	3
3	A2	6	5	2
4	A3	9	5	2
5	A4	15	5	3
6	A5	28	5	6
Sheet1

Cell Formulas
Range	Formula
H2:H6	H2	=COUNTIF(A:A,G2)
J2:J6	J2	=CEILING(H2/I2,1)

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Sheet1!$A$1:$E$70	H2:H6

Example Apply Filter on Column A1 and select value based on Range G1 and then select the first 5 rows of the filtered data , copy and paste the data in new worksheet along with header and save it on desktop. then again select data of filtered data in Column A1 and select the from 6th rosw of remaining data till 5 data and save second sheet and lastly select last value of A1 and save it in seperate worksheet . There will be 3 files containing all A1 data. and move to next value I.E A2 and so on.

What do you want these new workbooks to be called and what do you want the sheet to be called?

 

[earthworm]

What do you want these new workbooks to be called and what do you want the sheet to be called?

Workbook to be name as A1 part 1 A1 Part 2 and so on depending on data sheet count. However if there is a data for one workbook only it should be name as A1. And when A2 starts it should name as A2

Sheet name default is not an issue

Please note that data should be save as separate workbook

 

[earthworm]

bump

 

[Herakles]

bump

Give this a go on a copy of your data.

I have assumed that the sheet containing your data is called 'Data' and that the other sheet is called 'Spec' but you can change those names in the code where indicated.

It saves the files in the same folder but that can be changed. The path is stored on the strPath variable.

Public Sub subSplitData()
Dim arrSpec() As Variant
Dim arrData() As Variant
Dim WsSpec As Worksheet
Dim WsData As Worksheet
Dim i As Integer
Dim ii As Integer
Dim rngFound As Range
Dim intOffset As Integer
Dim lngSize As Long
Dim strPath As String
Dim intCount As Integer

    ActiveWorkbook.Save
    
    Application.ScreenUpdating = False
    
    strPath = ActiveWorkbook.Path & "\"  ' CHANGE THE PATH AS APPROPRIATE.

    Set WsData = Worksheets("Data") ' CHANGE THIS WORKSHEET NAME AS APPROPRIATE.
        
    Set WsSpec = Worksheets("Spec") ' CHANGE THIS WORKSHEET NAME AS APPROPRIATE.
        
    With WsSpec
        arrSpec = .Range("G2:J" & .Range("G2").CurrentRegion.Rows.Count).Value
    End With
        
    For i = LBound(arrSpec) To UBound(arrSpec)
    
        Set rngFound = WsData.Range("A1").CurrentRegion.Columns(1).Find(arrSpec(i, 1), LookIn:=xlValues).Resize(arrSpec(i, 3), 4)
        
        intOffset = arrSpec(i, 3)
        
        lngSize = arrSpec(i, 3)
        
        For ii = 1 To arrSpec(i, 4)
            
            If ii = arrSpec(i, 4) And ((arrSpec(i, 2) Mod arrSpec(i, 3)) <> 0) Then
                lngSize = (arrSpec(i, 2) Mod arrSpec(i, 3))
            End If
         
            Application.DisplayAlerts = False
            On Error Resume Next
            Kill strPath & arrSpec(i, 1) & " part " & ii & ".xlsx"
            On Error GoTo 0
            Application.DisplayAlerts = True
            
            Workbooks.Add
            With ActiveWorkbook
                .SaveAs strPath & arrSpec(i, 1) & " part " & ii
                rngFound.Resize(lngSize, 4).Copy .Sheets(1).Range("A2")
                .Sheets(1).Range("A1:D1").Value = WsData.Range("A1:D1").Value
                .Sheets(1).name = arrSpec(i, 1)
                .Close True
            End With
            
            Set rngFound = rngFound.Offset(intOffset, 0).Resize(lngSize, 4)
          
            intCount = intCount + 1
            
        Next ii
    
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox intCount & " files created.", vbOKOnly, "Confirmation."

End Sub

 

[earthworm]

The code is working perfectly fine . However I need to make some changes as per my requirement . But I am lost . Can you please make the changes in code as per below data set

RDA Working for Other Bank Auto File.xlsb
	A	B	C	D	E	F	G	H	I	J
1	Transaction Reference Number	Acccount No	Beneficiary Name	Amount	Bank		Total Count	Data Count	SplitSize	Number of Files
2					ABL		ABL	30178	15000	3
3					ABL		BAF	10402	15000	1
4					ABL		BAHL	29523	15000	2
5					ABL		FAY	6610	15000	1
6					ABL		HBL	74470	15000	5
7					ABL		MEEZAN	62254	15000	5
8					ABL		MCB	18528	15000	2
9					ABL		BOP	12101	15000	1
10					ABL		SCB	3845	15000	1
11					ABL		JS	3028	15000	1
12					ABL		DIB	2358	15000	1
13					ABL		HMB	5222	15000	1
14					ABL		SAMBA	238	15000	1
For RDA Bank

Cell Formulas
Range	Formula
G2:G15	G2	=UNIQUE(E2:E1048575)
H2:H14	H2	=COUNTIF($E$2:$E$1048575,G2)
J2:J14	J2	=CEILING(H2/I2,1)
Dynamic array formulas.

 

[earthworm]

Bump.

 

[earthworm]

Give this a go on a copy of your data.

I have assumed that the sheet containing your data is called 'Data' and that the other sheet is called 'Spec' but you can change those names in the code where indicated.

It saves the files in the same folder but that can be changed. The path is stored on the strPath variable.

Public Sub subSplitData()
Dim arrSpec() As Variant
Dim arrData() As Variant
Dim WsSpec As Worksheet
Dim WsData As Worksheet
Dim i As Integer
Dim ii As Integer
Dim rngFound As Range
Dim intOffset As Integer
Dim lngSize As Long
Dim strPath As String
Dim intCount As Integer

    ActiveWorkbook.Save
   
    Application.ScreenUpdating = False
   
    strPath = ActiveWorkbook.Path & "\"  ' CHANGE THE PATH AS APPROPRIATE.

    Set WsData = Worksheets("Data") ' CHANGE THIS WORKSHEET NAME AS APPROPRIATE.
       
    Set WsSpec = Worksheets("Spec") ' CHANGE THIS WORKSHEET NAME AS APPROPRIATE.
       
    With WsSpec
        arrSpec = .Range("G2:J" & .Range("G2").CurrentRegion.Rows.Count).Value
    End With
       
    For i = LBound(arrSpec) To UBound(arrSpec)
   
        Set rngFound = WsData.Range("A1").CurrentRegion.Columns(1).Find(arrSpec(i, 1), LookIn:=xlValues).Resize(arrSpec(i, 3), 4)
       
        intOffset = arrSpec(i, 3)
       
        lngSize = arrSpec(i, 3)
       
        For ii = 1 To arrSpec(i, 4)
           
            If ii = arrSpec(i, 4) And ((arrSpec(i, 2) Mod arrSpec(i, 3)) <> 0) Then
                lngSize = (arrSpec(i, 2) Mod arrSpec(i, 3))
            End If
        
            Application.DisplayAlerts = False
            On Error Resume Next
            Kill strPath & arrSpec(i, 1) & " part " & ii & ".xlsx"
            On Error GoTo 0
            Application.DisplayAlerts = True
           
            Workbooks.Add
            With ActiveWorkbook
                .SaveAs strPath & arrSpec(i, 1) & " part " & ii
                rngFound.Resize(lngSize, 4).Copy .Sheets(1).Range("A2")
                .Sheets(1).Range("A1:D1").Value = WsData.Range("A1:D1").Value
                .Sheets(1).name = arrSpec(i, 1)
                .Close True
            End With
           
            Set rngFound = rngFound.Offset(intOffset, 0).Resize(lngSize, 4)
         
            intCount = intCount + 1
           
        Next ii
   
    Next i
   
    Application.ScreenUpdating = True
   
    MsgBox intCount & " files created.", vbOKOnly, "Confirmation."

End Sub

Please help me make some minor tweaks in fitting as per my data shape

 

[earthworm]

please help