Macros to filter for each Unique Value

[KJP13]

Hi,

I am trying to create a macro to copy data from one excel workbook to another. I need to do this for each name listed. There may be multiple lines for each name so must filter for each name and copy all data.

The list of names will differ each day that this macro is run so i cannot use the specific names in the macro. Not used macros in a long time and memory is completely failing me. Any help appreciated. Data example below

Name	Date	City	Country	Amount	Yes/No
Alex	2/5/15	London	UK	55	No
Linda	3/5/15	Glasgow	UK	62	Yes
John	5/5/15	Birmingham	UK	32	No
Alex	9/5/15	London	UK	22	Yes
Leo	10/5/15	Edinburgh	UK	36	Yes
Alex	15/5/15	Nottingham	UK	99	No

<tbody>
</tbody>

Result should be 4 individual work books, 1 for Alex with 3 lines, 1 for Linda with 1 line, 1 for John with 1 line and 1 for Leo with 1 line.

Thanks

 

[Fluff]

How about

Sub SplitWbk()
   Dim Cl As Range
   Dim Ws As Worksheet
   
   Application.ScreenUpdating = False
   Set Ws = Sheets("Sheet1")
   With CreateObject("scripting.dictionary")
      If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            Ws.Range("A1:F1").AutoFilter 1, Cl.Value
            Workbooks.Add
            Ws.AutoFilter.Range.Copy Range("A1")
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Cl.Value & ".xlsm", 52
            ActiveWorkbook.Close False
         End If
      Next Cl
      Ws.AutoFilterMode = False
   End With
End Sub

 

[KJP13]

Thank you, this works perfectly, appreciate it.

 

[Fluff]

Glad to help & thanks for the feedback