use VBA to auto-filter and copy filtered data to another sheet

[Eliehaddad]

Hello,

please i need you assistance to automaticaly filter data in a specific table based on the customer name and copy the filtered data related to this customer to another worksheet using VBA

example: i need to automaticaly filter the projects by the name of the project owner and autocopy the related data of the projects to another sheet.

project name	decsription	project owner
mars	XXX	Sam
venus	YYY	Mark
earth	ZZZ	Sam

<tbody>
</tbody>

so will have this result in the 2nd sheet

project name	decsription	project owner
mars	XXX	Sam
earth	ZZZ	Sam

<tbody>
</tbody>

thank you in advance

 

[mumps]

What is the name of the sheet containing the data you want to filter? Do you want to copy each owner's data to a separate sheet? What are the names of the destination sheets?

 

[Fluff]

Hi & welcome to MrExcel.
A few questions
1) do you have a header row in row1, with data starting in A2?
2) is the project owner in column C?
3) Do the other sheets already exist, or do they need to be created.
4) If the sheets do exist, should the new data overwrite what's there, or add to it?

 

[Eliehaddad]

Hello,

1- header is at row 4
2- data starts at row 5
3- project owner is in column C, strarting C5 till C16
4- other sheets exist . i named them as the owners names so when i click to a certain sheet i can only see the projects of a specific project owner.
5- the sheets are in a standardized design just like the main sheet
6- is there anyway i can send you the sheet?

thank you

 

[vcoolio]

Hello Eliehaddad,

Try the following code in a copy of your workbook first:-

Option Explicit
Sub TransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim sh As Worksheet
        Set sh = Sheets("Report")
        
Application.ScreenUpdating = False

ar = sh.Range("C5", sh.Range("C" & sh.Rows.Count).End(xlUp))

For i = LBound(ar) To UBound(ar)

With sh.[A4].CurrentRegion
           .AutoFilter 3, ar(i, 1)
           .Offset(1).EntireRow.Copy
           Sheets(ar(i, 1)).Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
           .AutoFilter
     End With
Next i

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[Fluff]

How about

Sub MoveDupes()
   Dim ws As Worksheet
   Dim Cl As Range
   
   Set ws = Sheets("Sheet1")
   If ws.AutoFilterMode Then ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In ws.Range("C5", ws.Range("C" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            ws.Range("A4").AutoFilter 3, Cl.Value
            ws.AutoFilter.Range.Offset(1).Copy Sheets(Cl.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Cl
   End With
   ws.AutoFilterMode = False
End Sub

 

[Eliehaddad]

it seems no,

 

[Fluff]

If you want to share your workbook, you'll need to upload it to a share site such as OneDrive, Dropbox, or GoogleDrive, mark it for sharing & then post the link to the thread.
If the code codes supplied are not working, are you getting any error messages?

 

[Eliehaddad]

here you go,
https://drive.google.com/drive/folders/1zl0JO-dyVWgI2kssydS5piVXOvQCY346?usp=sharing

 

[Eliehaddad]

Disregard previous link
https://drive.google.com/file/d/1IKsqygFeTNN5RQfhTZH2dsk1QJNW_8cZ/view?usp=sharing