Macro to move data from one sheet into it correct sheet.

[tonywatsonhelp]

Hi Everyone,

So this is what I have,
I have a sheet named "Receipts" which currently contains every client data.

The Data is all tidy sorted and exactly as I want it I just need to separate out each client and post then in their own tabs.
The Tabs have all been created and the Tab Names are Exactly the same so the names I want to use and there no worry about duplicates or anything.

So I a nut shell this is what I want

I have a list of ever clients name in a tab called "Sheet Names" Down Column A The Exact range is Range("A2:A198") and this can be used as it wont change.

so the way I see it

Take The first Name from

"Sheet Names"

Range("A2:A198")
goto sheet "

Receipts" Filter column H for that name,
Copy Column A:I of filtered data,
Find Sheet Call the name we filtered
goto that sheet Paste data into that sheet cell c12

and repeat until all names have been done.

Only snag, not all names in the List will have data to copy so must have some that says if after filter no data is there move on to next.

Please help if you can

Thanks

Tony​

_{^{<strike>
</strike>}}​

​

<strike></strike>

 

[Peter_SSs]

There should be no need to use the "Sheet names" sheet. The following code just uses the names that are actually used on the "Receipts" sheet & transfers their data.
You didn't specify whether or not to copy the heading each time from "Receipts" to the individual sheets. I have assumed not - just the data from row 2 down.

Sub SplitReceipts()
  Dim d As Object
  Dim a As Variant, itm As Variant
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  Application.ScreenUpdating = False
  With Sheets("Receipts")
    a = .Range("H2", .Range("H" & .Rows.Count).End(xlUp)).Value
    For Each itm In a
      d(itm) = Empty
    Next itm
    With .Range("A1:I" & UBound(a) + 1)
      For Each itm In d.keys()
        .AutoFilter Field:=8, Criteria1:=itm
        .Offset(1).Resize(.Rows.Count - 1).Copy Destination:=Sheets(itm).Range("C12")
      Next itm
    End With
    .AutoFilterMode = False
  End With
  Application.ScreenUpdating = True
End Sub

 

[tonywatsonhelp]

Brilliant, Thank you very much for your help Peter

Tony

 

[Peter_SSs]

Brilliant, Thank you very much for your help Peter

Tony

You're welcome.