VBA Code Filter data paste into new workbook and email

Declamatory

Active Member
Joined
Nov 6, 2014
Messages
319
Hi Folks,

I'm hoping somebody can help me. I have a workbook that has rows of transaction data with each row being a transaction. The transactions relate to a number of clients.

I currently use the following code to filter the clients by account number so all the transactions for one client are viewable then copy and paste the transactions for that client into a new worksheet. It's a bit crude because I have to update the code every time I get a new client.

Code:
Sheets("Transactions").Select
ActiveSheet.Cells(1, 1).Select
    ActiveCell.CurrentRegion.Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    LR = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Range("D1:D" & LR).AutoFilter Field:=1, Criteria1:= _
            "<>19720428"
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    ActiveSheet.AutoFilterMode = False
    ActiveSheet.Name = "19720428 – Client Smith"
    Sheets("Transactions").Select

This code is then repeated for every client. Then I use the following code to split out each worksheet in the workbook into a separate workbook for each client.

Code:
For Each xWs In Workbooks("Transactions.xlsm").Worksheets
   If xWs.Name <> "Transactions" Then
      xWs.Copy
      Application.ActiveWorkbook.SaveAs FileName:=xPath & "\" & xWs.Name & ".xlsx"
      Application.ActiveWorkbook.Close False
   End If
Next xWs

Is there a way I can streamline this process as it is getting to the stage where there are too many clients. I need every client to have their own workbook but I don't need every client to have their own worksheet in the Transactions workbook.

Ideally I would love these workbooks to be emailed automatically (The email address of the client is in the transaction data).

I apologise if I haven't been clear enough.

Thanks
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Is the client name anywhere in the sheet?
 
Upvote 0
How about
Code:
Sub CopyFilter()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim pth As String
   
   pth = [COLOR=#ff0000]"C:\MrExcel\Fluff\"[/COLOR]
   Set Ws = Sheets("Pcode")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("D2", Ws.Range("D" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Value & " - Client " & Cl.Offset(, -3).Value
            Workbooks.Add (1)
            Ws.Range([COLOR=#ff0000]"A1:H1"[/COLOR]).AutoFilter 4, Cl.Value
            Ws.AutoFilter.Range.Copy Range("A1")
            ActiveWorkbook.SaveAs pth & .Item(Cl.Value) & ".xlsx", 51
            ActiveWorkbook.Close False
         End If
      Next Cl
   End With
   Ws.AutoFilterMode = False
End Sub
Change values in red to suit
 
Upvote 0
Hi Fluff,

This is brilliant. Thank You!!

Is there a way that the range could be made to be current region? The number of transactions changes each month. its not a problem to update the macro each month but would be a nice to have.

Thanks again. great job
 
Upvote 0
Do the number of columns vary each month?
If not what is the last column?
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,214,985
Messages
6,122,606
Members
449,089
Latest member
Motoracer88

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