Macro to filter and copy to new excel

Hi Team,

I am trying to automate a manual activity that I does daily. I am trying to write macro to eliminate this manual activity.

I have an excel dump with lot of associates tagged under a list of projects. So each project will have so many associates tagged.

The manual activity that I do is to filter a project, copy all the content and paste it in a new excel. Then filter the 2nd project, copy the content in another new excel and move on to the next project. In this way I split the master dump based on the project id and each project details are saved in individual new excel files.

I need help in automating this by writing a macro. Based on the project id, all the details in the sheet has to be saved in new excel. So if there are 10 projects in the master dump, each project content should be saved in 10 different excel files.

Sample data attached. Please help. I am new to macros.

Sub test()
    Dim e
    Application.ScreenUpdating = False
    With Sheets("sheet1").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        For Each e In Filter(.Parent.[transpose(if(countif(offset(d2:d10000,,,row(1:10000)),d2:d1000)=1,d2:d1000,char(2)))], Chr(2), 0)
            .AutoFilter 4, e
            .Copy Sheets("sheet2").Cells(1)
            Sheets("sheet2").Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
            ActiveWorkbook.Close
            .AutoFilter: Sheets("sheet2").Cells.Clear
        Next
    End With
    Application.ScreenUpdating = False
End Sub

Originally Posted by jindon

Sub test()
    Dim e
    Application.ScreenUpdating = False
    With Sheets("sheet1").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        For Each e In Filter(.Parent.[transpose(if(countif(offset(d2:d10000,,,row(1:10000)),d2:d1000)=1,d2:d1000,char(2)))], Chr(2), 0)
            .AutoFilter 4, e
            .Copy Sheets("sheet2").Cells(1)
            Sheets("sheet2").Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & e & ".xlsx"
            ActiveWorkbook.Close
            .AutoFilter: Sheets("sheet2").Cells.Clear
        Next
    End With
    Application.ScreenUpdating = False
End Sub

This is working perfectly fine.. If you can explain me what the below means it would be of great help and I will be able to change as required..

For Each e In Filter(.Parent.[transpose(if(countif(offset(d2:d10000,,,row(1:10000)),d2:d1000)=1,d2:d1000,char(2)))], Chr(2), 0)
.AutoFilter 4, e

Requesting you explain what " e " means.
What should I do if the excels should be saved with name as in column E.

Also if I need to change the filter base from coloum D to column A, where should I make the changes.. Please help..

e = Element in Array created by Filter function.
Examine the difference

Sub test()
    Dim e
    Application.ScreenUpdating = False
    With Sheets("sheet1").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        For Each e In Filter(.Parent.[transpose(if(countif(offset(a2:a10000,,,row(1:10000)),a2:a1000)=1,a2:a1000&char(3)&e2:e10000,char(2)))], Chr(2), 0)
            .AutoFilter 1, Split(e, Chr(3))(0)
            .Copy Sheets("sheet2").Cells(1)
            Sheets("sheet2").Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Split(e, Chr(3))(1) & ".xlsx"
            ActiveWorkbook.Close
            .AutoFilter: Sheets("sheet2").Cells.Clear
        Next
    End With
    Application.ScreenUpdating = False
End Sub

Thank you sir.. That helped a lot..
Last question - can you plz tell me what chr(2),Chr(3) means..

Chr function returns string from the character code.

See VBA Help.