VBA to filter data and copy various sheets to new workbook

[davey4444]

Hello,

I have a workbook which has a list of managers and customers and I would like to create a new workbook for each manager which only lists their particular customers. I've seen some VBA which can do this however the additional element is that I would like the new workbook to include some other sheets from the original file too.
Additionally I would then like to save the newly-created file with the name format of Region-Area-Manager if possible.
Below is an example of how the data is laid out in the main template file so, for example, the first newly-created file would show just the data for "Sales 1", togther with various other sheets from that file.

	A	B	C	D	E	F	G
1	Person	Region	Area	Customer Name	Prod A	Prod B	Prod C
2	Sales 1	Scotland	Other Scotland	Customer LIY	1	2	3
3	Sales 1	Scotland	Other Scotland	Customer CLN	1	2	3
4	Sales 1	Scotland	Other Scotland	Customer IHA	1	2	3
5	Sales 1	Scotland	Other Scotland	Customer JKI	1	2	3
6	Sales 10	England	West	Customer FDM	0.9	0.51	5
7	Sales 10	England	West	Customer YBI	0.9	0.51	5
8	Sales 10	England	West	Customer XKB	0.9	0.51	5
9	Sales 10	England	West	Customer QWY	0.9	0.51	5
10	Sales 11	Wales	Other Wales	Customer YSV	0.9	0.51	5
11	Sales 11	Wales	Other Wales	Customer EUZ	0.9	0.51	5
12	Sales 11	Wales	Other Wales	Customer ARL	0.9	0.51	5
13	Sales 11	Wales	Other Wales	Customer ALZ	0.9	0.51	5
14	Sales 12	Wales	Glamorgan	Customer ENN	0.9	0.51	5
15	Sales 12	Wales	Glamorgan	Customer IEH	0.9	0.51	5
16	Sales 12	Wales	Glamorgan	Customer EHJ	0.9	0.51	5
17	Sales 12	Wales	Glamorgan	Customer OBY	0.9	0.51	5
18	Sales 2	Scotland	Dundee	Customer AVL	1	2	3
19	Sales 2	Scotland	Dundee	Customer OZQ	1	2	3

<tbody>
</tbody>

Template 1​

 

[Fluff]

How about

Sub davey4444()
   Dim Ary As Variant, Ky As Variant
   Dim Dic As Object
   Dim Cl As Range
   
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Array("Template 1", "Data", "Test")
   With Sheets("Template 1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic.item(Cl.Value) = Cl.Offset(, 1).Value & "-" & Cl.Offset(, 2).Value & "-" & Cl.Value
      Next Cl
   End With
   For Each Ky In Dic.keys
      Sheets(Ary).Copy
      With ActiveWorkbook.Sheets("Template 1")
         .Range("a1").AutoFilter 1, "<>" & Ky
         .AutoFilter.Range.Offset(1).EntireRow.Delete
         .AutoFilterMode = False
      End With
      ActiveWorkbook.SaveAs Dic(Ky), 51
   Next Ky
End Sub

 

[davey4444]

Thanks for the quick reply. This code managed to create a new book for each person in the expected format however only first one created (Sales 1) showed any data in it with all of the other workbooks just showing the first row.

 

[Fluff]

Ok, how about

Sub davey4444()
   Dim Ary As Variant, Ky As Variant
   Dim Dic As Object
   Dim Cl As Range
   
   Application.ScreenUpdating = False
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Array("Template 1", "Data", "Test")
   With Sheets("Template 1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic.item(Cl.Value) = Cl.Offset(, 1).Value & "-" & Cl.Offset(, 2).Value & "-" & Cl.Value
      Next Cl
   End With
   For Each Ky In Dic.keys
      Sheets(Ary).Copy
      With ActiveWorkbook.Sheets("Template 1")
         .Range("a1").AutoFilter 1, "<>" & Ky
         .AutoFilter.Range.Offset(1).EntireRow.Delete
         .AutoFilterMode = False
      End With
      ActiveWorkbook.SaveAs "C:\Mrexcel\Fluff\" & Dic(Ky), 51
      ActiveWorkbook.Close
   Next Ky
End Sub

 

[davey4444]

This now works perfectly. Thank you.

 

[Fluff]

You're welcome & thanks for the feedback