Macros to filter for each Unique Value

KJP13

New Member
Joined
Sep 17, 2015
Messages
24
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


[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Date[/TD]
[TD]City[/TD]
[TD]Country[/TD]
[TD]Amount[/TD]
[TD]Yes/No[/TD]
[/TR]
[TR]
[TD]Alex[/TD]
[TD]2/5/15[/TD]
[TD]London[/TD]
[TD]UK[/TD]
[TD]55[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]Linda[/TD]
[TD]3/5/15[/TD]
[TD]Glasgow[/TD]
[TD]UK[/TD]
[TD]62[/TD]
[TD]Yes[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]5/5/15[/TD]
[TD]Birmingham[/TD]
[TD]UK[/TD]
[TD]32[/TD]
[TD]No[/TD]
[/TR]
[TR]
[TD]Alex[/TD]
[TD]9/5/15[/TD]
[TD]London[/TD]
[TD]UK[/TD]
[TD]22[/TD]
[TD]Yes[/TD]
[/TR]
[TR]
[TD]Leo[/TD]
[TD]10/5/15[/TD]
[TD]Edinburgh[/TD]
[TD]UK[/TD]
[TD]36[/TD]
[TD]Yes[/TD]
[/TR]
[TR]
[TD]Alex[/TD]
[TD]15/5/15[/TD]
[TD]Nottingham[/TD]
[TD]UK[/TD]
[TD]99[/TD]
[TD]No[/TD]
[/TR]
</tbody>[/TABLE]

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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
How about
Code:
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
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top