Loop to create newsheets for each owner & copy, paste data of each owner into the new sheet

[suresh7860]

HI Experts

Good Morning!!

I am have created a macro to consolidate 3 different reports to combine score, criteria and owner details by using combo and convert the report into pdf which is working fine but now requirement has changed that i should report each owner data into different tab and convert it but i am not able to get the details like how to export all the rows of each owner into different tab and rename the tabs as per the owner as i am very poor with vba loops. If any of the experts can help me to export data of each owner for a particular sheet and rename it with owner name and loop should run until the lastrow.

We don't have list of owners and number of rows, here it should create 3 sheets as we have 3 owners (Suresh, Sainath & Sanjay) and entire rows related to each owner should be moved to respective sheet and rename the sheets as Suresh, Sanjay & Sainath. I tried to research in google for this but didnt find anything suitable one whichever i got was creating muliple sheets as owner name will be listed many times and which as per my criteria we should have only one sheet for each owner name with his details.

Rows	Combo (A)	Owner (B)	Criteria(C)	Standard (D)	Achieved(E)	Total Score(F)
1	1001-100001-A001	Suresh	A	10	0	80
2	1001-100001-A001	Suresh	B	5	5	80
3	1001-100001-A001	Suresh	C	5	5	80
4	1001-100001-A001	Suresh	D	10	0	80
5	1001-100001-A001	Suresh	E	15	15	80
6	1001-100001-A001	Suresh	F	10	10	80
7	1001-100001-A001	Suresh	G	10	10	80
8	1001-100001-A001	Suresh	H	10	10	80
9	1001-100001-A001	Suresh	I	15	15	80
10	1001-100001-A001	Suresh	J	10	10	80
11	1002-100002-A002	Sanjay	A	10	10	85
12	1002-100002-A002	Sanjay	B	5	5	85
13	1002-100002-A002	Sanjay	C	5	5	85
14	1002-100002-A002	Sanjay	D	10	10	85
15	1002-100002-A002	Sanjay	E	15	0	85
16	1002-100002-A002	Sanjay	F	10	10	85
17	1002-100002-A002	Sanjay	G	10	10	85
18	1002-100002-A002	Sanjay	H	10	10	85
19	1002-100002-A002	Sanjay	I	15	15	85
20	1002-100002-A002	Sanjay	J	10	10	85
21	1003-100003-A003	Sainath	A	10	10	95
22	1003-100003-A003	Sainath	B	5	5	95
23	1003-100003-A003	Sainath	C	5	0	95
24	1003-100003-A003	Sainath	D	10	10	95
25	1003-100003-A003	Sainath	E	15	15	95
26	1003-100003-A003	Sainath	F	10	10	95
27	1003-100003-A003	Sainath	G	10	10	95
28	1003-100003-A003	Sainath	H	10	10	95
29	1003-100003-A003	Sainath	I	15	15	95
30	1003-100003-A003	Sainath	J	10	10	95
31	1004-100004-A004	Suresh	A	10	10	75
32	1004-100004-A004	Suresh	B	5	5	75
33	1004-100004-A004	Suresh	C	5	5	75
34	1004-100004-A004	Suresh	D	10	10	75
35	1004-100004-A004	Suresh	E	15	15	75
36	1004-100004-A004	Suresh	F	10	10	75
37	1004-100004-A004	Suresh	G	10	10	75
38	1004-100004-A004	Suresh	H	10	0	75
39	1004-100004-A004	Suresh	I	15	0	75
40	1004-100004-A004	Suresh	J	10	10	75
41	1005-100005-A005	Sanjay	A	10	10	90
42	1005-100005-A005	Sanjay	B	5	0	90
43	1005-100005-A005	Sanjay	C	5	0	90
44	1005-100005-A005	Sanjay	D	10	10	90
45	1005-100005-A005	Sanjay	E	15	15	90
46	1005-100005-A005	Sanjay	F	10	10	90
47	1005-100005-A005	Sanjay	G	10	10	90
48	1005-100005-A005	Sanjay	H	10	10	90
49	1005-100005-A005	Sanjay	I	15	15	90
50	1005-100005-A005	Sanjay	J	10	10	90
51	1006-100006-A006	Suresh	A	10	10	75
52	1006-100006-A006	Suresh	B	5	5	75
53	1006-100006-A006	Suresh	C	5	5	75
54	1006-100006-A006	Suresh	D	10	10	75
55	1006-100006-A006	Suresh	E	15	15	75
56	1006-100006-A006	Suresh	F	10	10	75
57	1006-100006-A006	Suresh	G	10	10	75
58	1006-100006-A006	Suresh	H	10	10	75
59	1006-100006-A006	Suresh	I	15	0	75
60	1006-100006-A006	Suresh	J	10	0	75
61	1007-100007-A007	Sainath	A	10	10	100
62	1007-100007-A007	Sainath	B	5	5	100
63	1007-100007-A007	Sainath	C	5	5	100
64	1007-100007-A007	Sainath	D	10	10	100
65	1007-100007-A007	Sainath	E	15	15	100
66	1007-100007-A007	Sainath	F	10	10	100
67	1007-100007-A007	Sainath	G	10	10	100
68	1007-100007-A007	Sainath	H	10	10	100
69	1007-100007-A007	Sainath	I	15	15	100
70	1007-100007-A007	Sainath	J	10	10	100

<tbody>
</tbody>

Thanks for your time & help!

Regards
Suresh7860

 

[Ombir]

For Input Data in Sheet1, Try this:

Sub Suresh()
Dim i       As Long
Dim rng     As Range
Dim Q       As Variant
Dim dict    As Object
Dim ar      As Variant

Set rng = Sheets("Sheet1").Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
Set dict = CreateObject("scripting.dictionary")

With dict
For Each cell In rng
    If Not .exists(cell.Value) Then
        i = 1
        ReDim ar(1 To Application.CountIf(rng, cell.Value), 1 To 6)
        ar(i, 1) = cell.Offset(, -1): ar(i, 2) = cell.Value: ar(i, 3) = cell.Offset(, 1)
        ar(i, 4) = cell.Offset(, 2): ar(i, 5) = cell.Offset(, 3): ar(i, 6) = cell.Offset(, 4)
        .Add cell.Value, Array(ar, i)
    Else
        Q = .Item(cell.Value)
        Q(1) = Q(1) + 1
        Q(0)(Q(1), 1) = cell.Offset(, -1): Q(0)(Q(1), 2) = cell.Value: Q(0)(Q(1), 3) = cell.Offset(, 1)
        Q(0)(Q(1), 4) = cell.Offset(, 2): Q(0)(Q(1), 5) = cell.Offset(, 3): Q(0)(Q(1), 6) = cell.Offset(, 4)
        .Item(cell.Value) = Q
    End If
Next

For Each k In .keys
    Worksheets.Add().Name = k
    Sheets(k).Range("A1:F1") = Array("Combo(A)", "Owner(B)", "Criteria (C)", "Standard (D)", "Achieved (E)", "Total Score (F)")
    Sheets(k).Range("A2").Resize(.Item(k)(1), 6) = .Item(k)(0)
    Sheets(k).Columns.AutoFit
Next

End With
End Sub

Regards,
Ombir

 

[suresh7860]

Thank you Ombir its working fine Have a great weekend!!